TITLE MUSIC
;;;******  AS OF JAN. 12, 1971 *********
;  XGP INIT ADDED JAN 1974
↓T←1
T1←2
T2←3
T3←4
A←5
B ←6
C←7
D←10
E←11
F←12
H←14
OSP←13
↓P←15
↓FL←17
NACS←←5
NFACS←←4
INSXR←←NFACS-1
SSPCF←←10
SDFLG←←20
SNUMF←←40
FIXFLG←←1000
FLTFLG←←2000
DF←←400000
NUMFLG←←FIXFLG+FLTFLG
SSPC2F←←4000

RFLG←←0	;$$$%%&%$###""##$%$$$$$
DECLBIT←←400
RVBT←←400
PRVBT←←11
MULBIT←←1
ADDBIT←←2
FOOBIT←←100
INSBIT←←40
UGBIT←←4000
FPARBT←←200

SRACBT←←10000
SIACBT←←20000
GPBIT←←FOOBIT	;NOT I OR X.
FUNBIT←←40000
SWVBT←←100000	;DO NOT CHANGE ! SEE GFUNC.
VRBLBT←←200000
		;; RELOCATION AND FIXUP BITS .
.FXBTS←←1
LFXBTS←←2
VRELBT←←14+1
RRELBT←←4+1
IRELBT←←10+1
		;; FLAGS (RIGHT HALF):
CSBRBT←←1
SFOOBT←←10
USBRBT←←2
GFUNCF←←4
EXTFLG←←40
ARRFLG←←20
RVFLG←←100
RESTART←←200
		;FLAGS (LEFT HALF).
ERRFLG←←1
MINFLG←←2
SNUMF1←←4
NOSTAR←←10
DTFLG←←20
		;; PARAMETER DESCRIPTOR BITS:
FAOPAR←←1
FDPARB←←4
FDPARC←←5

COFF←←1000	;PI CHANNEL OFF.
CON←←2000
DACHN←←100	;PI CHANNEL 1.

LRFXBT←←200000	;LEFT HALF REPLACEMENT FIXUP BIT.
RRFXBT←←100000	;RIGHT HALF.
SWAPBT←←40000	;SWAPPED FIXUP.

;;;;; 5/74 DEFINE IOWD (A,B) <XWD -A,B-1>
OPDEF EXP [0]
OPDEF FIX [XWD 247000,0]	;FOR PDP10 ONLY. REMOVE WITH DDT FOR PDP6
;*********↑↑↑↑↑↑↑↑↑
OPDEF OUTCHR [XWD 51040,0]
;;UUOSER:	0
;;	MOVEM	A,SAVEA#
;;	HLRZ	A,40
;;	CAIL	A,2000
;;	JRST	FIXER
;;	MOVE	A,SAVEA
;;	JSR	ERR1
;;	JRSTF	@UUOSER


	;INPUT ROUTINE. CALL INITIALLY WITH PUSHJ P,SETUP
	;WILL READIN DTA# AND FILE NAME. GET CHRS BY
	;ILDB IBUF+1. NEXT BUFFER BY INPUT DT,0.
;;;EXTERNAL IFIX
EXTERNAL SMPLS

TTY←←10
DT←←11
ADCHN←←12
SETUP:	CALL [SIXBIT /RESET/]
SETUP1:	INIT TTY,1
	SIXBIT /TTY/
	XWD TOB,TIB
	CALL [SIXBIT /EXIT/];	ERROR CONDITION
	MOVSI 400000
	ANDCAM TIBUF+1	;MARK INPUT BUFFERS EMPTY.
	ANDCAM BUF1+1	
	ANDCAM BUF2+1
	ANDCAM BUF3+1
	HRRI TIBUF+1	;INIT. BUFFER POINTERS.
	MOVEM TIB
	HRRI TOBUF+1
	MOVEM TOB
	OUTPUT TTY,1;	SEE THE HAPPY SYSTEM
;;COLGATE	OUTPUT TTY,
	TRNE FL,RESTART	;ARE WE RESTARTINIG ?
	JRST SET4		;YES.
	MOVEI IMS
	JSR TXTOUT;	A LF/CR *
;; 5/74 	INPUT TTY,0;	THE DTA # AND NAME
;;	SETZM DNAM
;;	MOVE 2,[POINT 6,DNAM]
;;	MOVEI T2,6
;;SET3:	ILDB TIB+1
;;	CAIN ":"
;;	JRST SET4
;;	SUBI 40
;;	IDPB 2
;;	SOJG T2,SET3
;*******↓↓↓↓↓ 5/74
	EXTERNAL FILBRK,DLK,ASTR
	INTERNAL DEV
	SETZM	ASTR
	JSA	16,FILBRK
	MOVE	T2,[SIXBIT/TTY/]
	SKIPN	DLK
	MOVEM	T2,DNAM
;******↑↑↑↑↑
SET4:	INIT DT,1
DNAM:DEV:	SIXBIT /DTA/
	XWD 0,IBUF	;NO OUPUT ON THIS DEVICE.
	JRST AER1
	MOVE [XWD 400000,BUF1+1]	;ET UP BUFFER 
	MOVEM IBUF	;HEADER SO SYSTEM WILL USE OUR BUFFERS.
	MOVSI 700
	MOVEM SCP	;BYTE SIZE.
;; 5/74 	SETZM DLK+3	;TO READ FILES OFF DSK
	TRZE FL,RESTART
	JRST SETIN
;**** NEXT 2 ARE FOR SAVER
	MOVEI T,1
	MOVEM T,RECCT
;; 5/74 	MOVE T1,[POINT 6,DLK]
;;	SETZM DLK
;;	SETZM DLK+1
;;	MOVEI T2,12
	JRST SETIN
;***********↑↑↑↑↑

RIN:	ILDB TIB+1;	GET FILE NAME
	CAIN 15
	JRST SETIN
	CAIN ".";	AN EXTENSION
	JRST SETEX
	SUBI 40
	IDPB T1
	SOJG T2,RIN
	JRST SETIN
TIB:	0
	POINT 7,0,35
	0
TOB:	0
	POINT 7,0,35
	0
TIBUF:	0
	XWD 21,.
	BLOCK 22
TOBUF:	0
	XWD 21,.
	BLOCK 22
;THIS IS NOW IN FILBRK DLK:	BLOCK 4
IBUF:	XWD 400000,BUF1+1;	MAGIC TO KEEP SYSTEM
SCP:	POINT 7,0,35;	HAPPY
ICCNT:	0	;BUFFER CHAR. COUNT.
SETEX:	TLZ T1,770000
	JRST RIN
SETIN:	MOVE 0,DLK+3	;TO SAVE P,PN
	LOOKUP DT,DLK;	GET FILE SETUP
	JRST NER;	NON-EX FILE
	MOVEM 0,DLK+3	;PUTS BACK P,PN
	PUSHJ P,RDBUF	;GET FIRST BUFFER
	MOVE BUF1+3	;LINE NO. FIRST ?
	TRNE 1
	AOS SCP	;YES; ADVANCE SCP PAST IT.
	SETZM SNCHR
	SETZM FOONLY#	;BARF !!
	POPJ P,;	DONE
BUF1:	0
	XWD 201,BUF2+1
	BLOCK 202
BUF2:	0
	XWD 201,BUF3+1
	BLOCK 202
BUF3:	0
	XWD 201,BUF1+1
	BLOCK 202


AER1:	MOVEI DEV1MS;	ERROR ROUTINE FOR NOT AVAILABLE
	JSR TXTOUT;	DECTAPE
	MOVEI T1,4
	MOVEI DNAM
	PUSHJ P,SIXOUT
	MOVEI DEV2MS
	JSR TXTOUT
	JRST SETUP
NER:	MOVEI NAM1MS
	JSR TXTOUT
	MOVEI T1,6
	MOVEI DLK
	PUSHJ P,SIXOUT
	HLRZ DLK+1
	JUMPE NEX1
	MOVEI "."
	IDPB TOB+1
	MOVEI T1,3
	MOVEI DLK+1
	PUSHJ P,SIXOUT
NEX1:	MOVEI NAM2MS
	JSR TXTOUT
	JRST SETUP
NAM1MS:	ASCIZ /
FILE /
NAM2MS:	ASCIZ / NOT FOUND
/

DECPNT:	PUSHJ P,DECPNN		;SPACE COMES AFTER NUM IS TYPED.
	MOVEI A,40
	SOSGE TOB+2
	OUTPUT TTY,0
	IDPB A,TOB+1
	POPJ P,


DECPNN:	IDIVI A,12	;PRINT DECIMAL INTEGER FROM A.
	HRLM B,(P)	;SAVE LOW ORDER DIGIT.
	SKIPE A		;DONE ?
	PUSHJ P,DECPNN	;NO. RECUR FOR REST OF DIGITS.
	HLRZ A,(P)	;YES. GET HIGH ORDER DIGIT.
	ADDI A,"0"	;CONVERT TO ASCII.
	SOSGE TOB+2	;OUTPUT IT.
	OUTPUT TTY,0
	IDPB A,TOB+1
	POPJ P,		;RETURN.

SIXOUT:	TLO 440600	;	MAKE BYTE POINTER
LOOPTS:	SOJL T1,[POPJ P,]
	ILDB T,0
	JUMPE T,[POPJ P,]
	ADDI T,40
	IDPB T,TOB+1
	JRST LOOPTS
TXTOUT:	0
	TLO 440700;	ANOTHER POINTER
LPT1:	ILDB T,0
	JUMPE T,RETPT
	SOSGE TOB+2
	OUTPUT TTY,0
	IDPB T,TOB+1
	JRST LPT1
RETPT:	OUTPUT TTY,0
	JRST @TXTOUT
DEV1MS:	ASCIZ /
DEVICE /
DEV2MS:	ASCIZ / NOT AVAILABLE
/
IMS:	ASCIZ /
* INPUT ? /

RDBUF:	MOVEI [BYTE (7)15,12,52]	;ASCIZ / CR LF */
	MOVSI A,'TTY'
	CAME A,DNAM	;IS INPUT DEVICE A TTY ?
	TLO FL,NOSTAR	;NO. SUPRESS THE *.
	TLZN FL,NOSTAR	;PRINT IF NOSTAR NOT ON.
	CALLI 3		;YES. TYPE CR LF *.
;; NEXT 2 FOR SAVER
	USETI DT,@RECCT# ;POSITION INPUT FILE TO RIGHT RECORD.
        AOS   RECCT     ;ADD 1 TO RECORD CTR
	INPUT DT,0	;READ NEW INPUT BUFFER.
	STATZ DT,20000	;END OF FILE SEEN ?
	JRST SETUP	;YES.
	MOVEI 4	;MAKE SURE 0 WORD TERMINATES IT.
	ADD ICCNT	;CHAR. COUNT +4/5 IS WORD COUNT.
	MOVEI A,5	;BECAUSE WE DON'T WANT TO LOSE B.
	IDIVM A		;SEE? NO RANDOM REMAINDER !!
	ADD A,SCP	;ADD  BASE ADDRESS.
	IBP A		;BAGBITING SYSTEM.
	SETZM (A)	;ZERO IT.
	MOVE SCP
	MOVEM ISCP#	;SAVE FOR ERROR PRINTOUT.
	POPJ P,

SUBTTL   ALGOL SCANNER -- 9/8/66	D. POOLE

;CALL IS PUSHJ P,-----.  SCANS NEXT ATOMIC ELEMENT OF
; INPUT STRING, RETURNS ELEMENT IN ACCUM. 'A' AS FOLLOWS:
; UNDEFINED IDENTIFIER-- RETURNS 0.
;  DECLARED IDENTIFIER--- 'A' CONTAINS RANDOM GOOD BITS FROM
; THE SYM. TBL. IN LEFT HALF, PTR. TO RGB WORD IN RT. HALF.
;RESERVED WORD OR SINGLE-CHARACTER OPERATOR--- 'A' CONTAINS
;  THE RANDOM BITS WORD FROM EITHER THE RESERVED WORD TABLE
;  OR THE CHAR. CONVERT TABLE, RESPECTIVELY.


BUCKNO←←1;	SEE DFUNC BEFORE CHANGING !!!!

ACCUM:	BLOCK 40	;GOOD ENOUGH FOR NOW...

SCANNS:	TLOA FL,NOSTAR	;SUPRESS PRINTING OF *.

SCANR:	TLOA FL,400000	;ENTRY WHEN EXPECTING OPERATOR OR
			; RESERVED WORD.
SCANV:	TLZ FL,400000	;ENTRY WHEN EXPECTING VARIABLE.

SCAN:	
	SKIPE A,SNCHR#	;IF SNCHR IS NON-ZERO,
	JRST SL1	; IT IS THE NEXT CHAR. TO SCAN.
SL10:	ILDB A,SCP	;GET NEXT CHAR.
	SKIPN A,CTBL(A)	;SKIP LEADING BLANKS.
	JRST SL10

	JUMPL A,SL1A	;IF OPERATOR, WE'RE DONE.
	TLNE A,SNUMF	;CHECK FOR PART OF A NUMBER.
	JRST SNUM1
	MOVE T2,[POINT 6,ACCUM,5]	;PREPARE TO SCAN AN
	SETZB T,ACCUM	;IDENTIFIER.
	MOVEM T,ACCUM+1
	MOVEM A,FOONLY
SL2:	IDPB A,T2	;APPEND CHAR. TO IDENTIFIER.
	ILDB A,SCP	;NEXT CHAR.
	SKIPLE A,CTBL(A)	;CHECK FOR TERMINATOR.
	AOJA T,SL2	;INCREMENT COUNT AND LOOP.
	TLNE A,SSPC2F	;DOES TERMINATING CHAR. REQUIRE
	JRST SSPCB	;IMMEDIATE ATTENTION ?
	MOVEM A,SNCHR	;NO, SAVE IT FOR NEXT TIME.
	ADDI T,1
	DPB T,[POINT 6,ACCUM,5]	;PUT COUNT IN FIRST CHAR.
	HRRZS T2
	SUBI T2,ACCUM
	HRRZM T2,ACCWC#

	MOVE A,ACCUM	;PREPARE TO SEARCH TABLES.
	MOVE C,ACCUM+1
	TLZE FL,400000	;DO WE EXPECT AN OPERATOR ?
	JRST SRSCH	;YES; SEARCH RES. WD. TBL. FIRST
SMSCH:	MOVE T,A	;SEARCH MAIN SYM. TBL.
	IDIVI T,BUCKNO	;DO HASH ON IDENT.
	MOVMS T1	;MAKE SURE IT'S POSITIVE.
	MOVEM T1,CBNO#	;SAVE BUCKET NO.
	HRRZ B,BUCTBL(T1)	;HEAD OF RIGHT BUCKET
			; IN SYM. TBL.
SL5:	CAMN A,1(B)	;COMPARE FIRST WORDS.
	JRST SL4
SL6:	HRRZ B,(B)	;GET NEXT ELEMENT OF
	JRST SL5	;  THE LINKED LIST.
SL4:	CAIN B,A-1	;FIRST WORD WAS EQUAL...
	JRST SNO	; WE ARE AT END OF BUCKET.
	SKIPN T1,T2
	JRST SFOUND	;ONLY 1 WORD; WE'RE DONE.
	CAME C,3(B)	;COMPARE SECOND WORDS...
	JRST SL6	;NOPE.
	SOJE T1,SFOUND	;ANY MORE WORDS ?
	MOVE T3,[XWD B,4];	YES. PREPARE TO CHECK THEM.
SL7:	MOVE D,ACCUM-2(T3)
	CAME D,@T3
	JRST SL6	;NOT EQUAL.
	SOJE T1,SFOUND	;MORE STILL ?
	AOJA T3,SL7	;YES; KEEP CHECKING.

SFOUND:	MOVEI A,2(B)	;FOUND HIM; CALC. PTR. TO RGB WORD.
	HLL A,(A)	;GET RANDOM GOOD BITS.
	HRRZ B,A
SEXIT:	CAIG T2,1	;MORE THAN 2 WORDS OF NAME ?
	POPJ P,		;NO.
	SETZM ACCUM(T2)	;YES; ZERO OUT ALL THE WORDS OF
	SOJA T2,SEXIT	;  ACCUM THAT WE USED.

SNO:	TLCN FL,400000	;NOT IN MAIN TBL; HAVE WE ALREADY
	JRST SRSCH	; SEARCHED RES. WORD TBL ?
SN1:	MOVE A,FOONLY	;GARPBAZ !
	TLNE A,FOOBIT
	JRST FOOSCH
SCH1:	SETZB A,B	;YES. RETURN 'UNDEFINED'.
	POPJ P,

SL1:	SETZM SNCHR	;RETURN FOR A SPECIAL CHAR.
SL1A:	TLNN A,SSPCF+SSPC2F	;DOES IT NEED SPECIAL SERVICE ?
	POPJ P,		;NO.
	PUSHJ P,(A)	;YES. DISPATCH ON IT.
	JRST SL10	;CONTINUE SCANNING.

FOOSCH:	LDB B,[POINT 6,ACCUM,17]
	TRNE FL,SFOOBT	;ARE WE DEFINING A FUNCTION ?
	JRST SCH1	;YES. NO FOO-SYMBOLS ALLOWED.
	CAIG B,31	;IS IT A DIGIT?
	CAIGE B,20
	JRST SCH1	;NO.
	SUBI B,20	; TO VALUE.
	LDB C,[POINT 6,ACCUM,23]
	JUMPE C,FSCH1	
	LDB D,[POINT 6,ACCUM,29]
	JUMPN D,SCH1
	IMULI B,12	;MUL. TENS DIGIT BY 10.
	CAIG C,31
	CAIGE C,20
	JRST SCH1
	ADDI B,-20(C)	;ADD IN ONE'S DIGIT.
FSCH1:	DPB B,[POINT 17,A,35]	;PUT NUMBER IN A.
	POPJ P,	;RETURN FROM SCAN.
	

S.VT:	;HERE ON VERTICAL TAB.
S.FF:	;FORM FEED.
S.LF:	;LINE FEED
SENDL:	TLZ FL,ERRFLG	;END OF LINE. CLEAR ERROR FLAG.
	MOVEI A,1
	ADD A,SCP	;GET PTR TO NEXT WORD.
	SKIPN T,(A)
	JRST S.EOB	;ZERO WORD MEANS END OF BUFFER.
	TRNN T,1	;IS IT A LINE NO. ?
	POPJ P,		;NO; CONTINUE SCANNING.
	TLZ A,770000	;YES; ADVANCE PTR. PAST IT.
	MOVEM A,SCP
	POPJ P,
S.EOB:	PUSHJ P,RDBUF	;REFILL BUFFER.
	JRST SENDL

SSPCB:	HALT

SSPCC:	HALT

S.LT:	ILDB A,SCP	;'<' SEEN; SKIP TO END OF LINE.
	CAIE A,12	;A LINE FEED ?
	JRST S.LT	;NO.
	JRST SENDL

SNUM1:	MOVEI C,0	;NUMBER SCANNER.
	CAMN A,DOTV	;FIRST THING A DECIMAL PT.?
	JRST SNUM6	;YES
	MOVNI T,100	;NO DEC PT. YET.
SNUM2:	IMULI C,12
	ADDI C,-20(A)	;CONVERT NEW DIGIT TO VALUE AND ADD IN
	AOSA T		;INCREMENT DEC. PLACE COUNT.
SNUM6:	MOVEI T,0	;START COUNTING DEC. PLACES.
	ILDB A,SCP	;NEXT CHAR.
	SKIPG A,CTBL(A)	;GET MAGIC BITS.
	JRST SNUM7	;IT'S A DELIMITER.
	TLNE A,SDFLG	;IS IT A DIGIT ?
	JRST SNUM2	;YES.
	CAMN A,DOTV	;A DEC. PT. ?
	JRST SNUM6	;YES.
	JRST SNUMX1
SNUM7:	TLNE A,SSPC2F	;DOES DELIM. REQUIRE INSTANT SERVICE ?
	JRST SSPCC	;YES.
	MOVEM A,SNCHR	;SAVE FOR NEXT TIME.
SFLTIT:	IDIVI C,400000	;FLOAT IT.
	SKIPE C
	TLC C,254000
	TLC D,233000
	FAD C,D
	SKIPLE T
	FDVR C,[10.0]	;DIVIDE BY 10 ENOUGH TO GET
	SOJG T,.-1	;DEC. PT. IN RIGHT PLACE.
	SKIPA T,[XWD FLTFLG,0]	;GET FLOATING PT. FLAG.
SNFX:	MOVSI T,FIXFLG
	HLLZ A,T	;COPY FLAG TO A.
	TRNN FL,SFOOBT
	TLZE FL,SNUMF1
	POPJ P,

;; NOW SEARCH NUMBER TABLE FOR THE NUMBER.

	TDOA A,NUMBUC	;NUMBUC TO RT. HALF.
SNUM4:	HRR A,-1(A)	;GET NEXT LINK.
	CAME C,(A)	;IS IT EQUAL ?
	JRST .-2	;NO.
	TRNN A,777760	;ARE WE AT END OF TABLE ?
	JRST SNUMNO	;YES.
	TDNN T,-1(A)	;NO. DO TYPES MATCH ?
	JRST SNUM4	;NO.
	POPJ P,		;YUP. WE'VE FOUND IT.

SNUMNO:	TRNE FL,CSBRBT	;ARE WE INSIDE A FUNCTION DEFINITION ?
	JRST SNUMX	;YES.
	AOS B,JOBFF	;INSERT NEW NUMBER IN TABLE.
	HRR A,B
	EXCH B,NUMBUC	;UPDATE NUMBUC.
	HRRM B,-1(A)	;PUT IN NEW LINK.
	HLLM A,-1(A)	;PUT IN TYPE FLAG.
	MOVEM C,(A)	;ALSO VALUE.
	AOS T,JOBFF	;BUMP POINTER PAST VALUE.
	HRLM T,JOBSA
	POPJ P,

SNUMX:	IOR T,VLOC	;WE WILL PUT NO. IN VARIABLES AREA.
	PUSH P,T	;SAVE PTR. TO LOC. 
	MOVE A,C	;VALUE OF NO. TO A.
	MOVEI B,0	;NO RELOCATION.
	PUSHJ P,EMVCDI	;EMIT TO VARIABLES BUFFER.
	JRST POPAJ	;SEE EMINST.

; RESERVED WORD TABLE SEARCHER.


SRSCH:	LDB B,[POINT 6,ACCUM,5]	;GET CHAR. COUNT.
	CAIL B,3	;NO 1-CHAR. RES. WDS.
	CAILE B,13	;ALSO NONE OF > 9 CHARS.
	JRST SRNO
	MOVE B,SRTBL1-2(B)	;GET RIGHT SECTION OF TBL.
	CAME A,(B)	;COMPARE FIRST WORD.
SRS1:	AOBJN B,.-1
	JUMPGE B,SRNO	;ARE WE AT END OF SETCTION ?
	CAME C,LRTBL(B)	;NO; COMPARE SECOND WORD.
	JRST SRS1
	MOVE A,2*LRTBL(B)	;THIS IS IT; GET GOOD BITS.
	TLNE A,SSPCF	;DOES IT NEED OUR ATTENTION ?
	JRST (A)	;YES.
	JRST SEXIT	;NO.

SRNO:	TLCN FL,400000	;NOT A RES. WORD; HAVE WE ALREADY
	JRST SMSCH	;SEARCHED MAIN SYM. TBL. ?
	JRST SN1	; YES; RETURN.

.COMME:	MOVE A,SNCHR	;A COMMENT; SKIP TO NEXT ';'
	SETZM SNCHR
.COMM1:	CAMN A,SEMICV
	JRST SCAN
	TLNE A,SSPCF+SSPC2F	;SPECIAL TREATMENT ?
	PUSHJ P,(A)	;YES.
	ILDB A,SCP
	MOVE A,CTBL(A)
	JRST .COMM1


BUCTBL:	REPEAT BUCKNO,<EXP TEMPSY>	;TABLE OF HEADS OF THE 
			;HASH-CODED BUCKETS IN SYM. TABLE.

NUMBUC:	EXP C	;HEAD OF NUMBER TABLE

;THE CHARACTER CONVERSION TABLE -- GOOD BITS FOR EVERYONE !
;  GET YOURS WHILE THEY LAST !

OPDEF ILG [XWD DF+SSPCF,SILCH]

CTBL:	XWD DF+SSPCF,SENDL
	REPEAT 10,<ILG>
	0	; HORIZONTAL TAB.
	XWD DF+SSPCF,S.LF	;LINE FEED
	XWD DF+SSPCF,S.VT	; VERTICAL TAB
	XWD DF+SSPCF,S.FF	;FORM FEED
	0		;CARRIAGE RETURN.
	REPEAT 14,<ILG>
	XWD DF+SSPCF,SENDL	;↑Z.
	REPEAT 5,<ILG>
	0	;SPACE
	REPEAT 7,<ILG>
LPARV:	XWD DF,1
RPARV:	XWD DF,2
	XWD DF+MULBIT,MULOP	; *
PLSV:	XWD DF+ADDBIT,ADDOP	; +
COMMAV:	XWD DF,COMMOP	; ,
MINV:	XWD DF+ADDBIT,SUBOP	; -
DOTV:	XWD SNUMF,"."	; .
	XWD DF+MULBIT,DIVOP	; /
CTNUM:	REPEAT 12,<XWD SDFLG+SNUMF,20+.-CTNUM>	; THE DIGITS.

COLONV:	XWD DF,3	; :
SEMICV:	XWD DF,4	; ;
	XWD DF+SSPCF,S.LT	;<
;;	XWD DF+RELBIT,EOP	; =
	XWD DF,ASNOP	;← AND = DO THE SAME THING. 5/74
	XWD DF+RELBIT,GOP	; >
	REPEAT 2,<ILG>
CTLTR:	REPEAT =5,<XWD 0,41+.-CTLTR>	;THE LETTERS.
	41+.-CTLTR	;F
	REPEAT =9,<41+.-CTLTR>
	XWD FOOBIT,41+.-CTLTR+400000	;P
	REPEAT 4,<41+.-CTLTR>
	XWD FOOBIT,41+.-CTLTR
	REPEAT 5,<41+.-CTLTR>

LFTBRK:	XWD DF,5	; [
	ILG
RGTBRK:	XWD DF,6
UARV:	XWD DF,EXPOP	; ↑
LARV:	XWD DF,ASNOP	;← LEFT ARROW??
	REPEAT 35,<ILG>
ALTV:	XWD DF,.	;ALT MODE.
	REPEAT 2,<ILG>
;  END OF CONVERT TABLE.

DEFINE PUT1 (N,Y)
 < FOR X IN (Y)
    <Q←<SIXBIT /X/>
	 N*10000000000+(7777777777&(Q/100))
>>

DEFINE PUT2 (Y)
  <FOR X IN (Y)
	<SIXBIT /X/
>>

RTBL:		;THE RESERVED WORD TABLE.
RT3C:	PUT1 (3,END)	;THE 3-LETTER SECTION.
RT4C:	PUT1(4,<PLAY>)
RT5C:	PUT1(5,<ARRAY>)
RT6C:	PUT1 (6,FINIS)	;THE 6-LETTER SECTION.
RT7C:	PUT1 (7,<COMME,COMPI>)
RT8C:	PUT1 (10,<VARIA,FUNCT,EXTER>)	;VARIABLE
RT10C:	PUT1 (12,INSTR)	;

LRTBL←←.-RTBL

RTBL2:	0	;END
	0	;PLAY.
	0
	PUT2 (H)
	PUT2 (<NT,LE>)	;COMMENT
	PUT2 (<BLE,ION,NAL>)
	PUT2 (UMENT)	;INSTRUMENT

RF←←DF+RFLG

RTBL3:
ENDV:	XWD RF,.
PLAYV:	XWD RF,.
ARRV:	XWD RF+DECLBIT,DARR
FINV:	XWD RF,.
COMV:	XWD SSPCF,.COMME
COMPV:	XWD RF,.
VARV:	XWD RF+DECLBIT,DVRBL
FUNV:	XWD RF+DECLBIT,DFUNC	;FUNCTION
EXTV:	XWD RF+DECLBIT,EXTD
INSV:	XWD RF+DECLBIT,CINS

SRTBL1:	0	;2
   XWD -1,RT3C
   XWD -1,RT4C
   XWD -1,RT5C
   XWD -1,RT6C
   XWD -2,RT7C
   XWD -3,RT8C
	0
   XWD -1,RT10C
	0
SRSFOO:	JUMP 2*LRTBL(B)

;;		MORE BITS AND PARAMETERS.
RELBIT←←0

	;SIZES OF VARIOUS STACKS AND TABLES:
LOBUFS←←200
LUOTBL←←62
LPLIST←←100
LOSTK←←40
LPA←←62
LRQ←←=75		;LENGTH OF RUN QUEUE.

	;SPECIAL AC DEFINITIONS :
RA←16		;AC FOR JSA LINKAGE AT RUNTIME.


DEFINE MAKOP1  (X) 
	<FOR @$ A IN (X) 
	 <A$OP: HALT
	>>

MAKOP1 <PW,COMM,L,E,G,EXP,ENDS,WHLS>

;;  TEMPORARY AND DEBUGGING ROUTINES:

GO:	MOVE P,[IOWD LPLIST,PLIST]
	AOSE ONCEFG	;IS THIS FIRST TIME THROUGH ?
	JRST GOA	;NO. LEAVE JOBFF AT CURRENT PLACE.
	HRLZ 116	;YES. GET BOTTOM OF SYM. TAB. FROM JOBSYM.
	SUB 116		;ADD LENGTH OF SYM. TAB.
	HRLM JOBFF
GOA:	HRR JOBFF
	HRLM JOBSA
	MOVEI FL,0
	PUSHJ P,SETUP
GOB:	MOVE P,[IOWD LPLIST,PLIST]
 	MOVE [JSR ERR1]	;SET UP FOR ERROR UUO.
	MOVEM 41
	MOVE JOBREL
	MOVEM JOBSYM
	JRST SCHOWN

ONCEFG:	-1

DEFINE ERROR (M)
   <XWD 1000,[ASCIZ /M/]  >


UDIERR:	ERROR (UNDEFINED IDENTIFIER)

SILCH:	ERROR (ILLEGAL CHARACTER)
SNUMX1:	ERROR(ILLEGAL CHAR. IN NUMBER)
FNDWV:	HALT

TEMPSY:	EXP TMPS1Z
	PUT1 5,OSCIL
	XWD UGBIT,.+2
	0
	JSP RA,@OSCIL	;POINTER DID NOT RESET WITH '1,5,0,1' IN NEXT!!!!
	BYTE (6)4,2,2,1,4,0,1;***** JULY 3,71 THIS ENDED '1,5,0,1' ****
TMPS1Z:	TMPS1
	PUT1 6,ZOSCI
	XWD UGBIT,.+3
	PUT2 (L)
	0
	JSP RA,@ZOSCIL
	BYTE (6)4,2,2,1,5,0,1
;CHANGE LAST OF ABOVE TO .. 4,0,1 TO MAKE ZOSCIL NOT LIKE COSCIL
TMPS1:	EXP TIMESC+1
	PUT1 6,TIMES
	XWD VRBLBT,TIMESC
	PUT2 C
TIMESC:	1.0
	EXP SRATE+1
	PUT1 5,SRATE
	XWD VRBLBT,SRATE
SRATE:	10000.0
	EXP NCHNS+1
	PUT1 5,NCHNS
	XWD VRBLBT,NCHNS
NCHNS:	1
	EXP LSBUF+1
	PUT1 5,LSBUF
	XWD VRBLBT,LSBUF
LSBUF:	1000
	EXP TMPS2
	PUT1 3,OUT
	XWD UGBIT,.+2
	0
	JSA RA,@OUT
	BYTE (6)1,2,0,0
TMPS2:	EXP TMPS3
	PUT1 4,OUT2
	XWD UGBIT,.+2
	0
	JSA RA,@OUT2
	BYTE (6)3,2,2,2,0,0
TMPS3:	TMPS3A
	PUT1 5,SPEED
	XWD VRBLBT,SPEED
SPEED:	1
TMPS3A:  TMPS11
        PUT1 6,ZINTR
        XWD UGBIT,.+3
        PUT2 P
        JSA RA,IINTRP
        JSP RA,@ZINTRP
        BYTE (6)5,2,2,5,1,4,0,T

TMPS11:	TMNOSA
	PUT1 6,VFMUL
	XWD UGBIT,.+3
	PUT2 T
	0
	JSP RA,@VFMULT
	BYTE (6)3,2,2,1,0,T
; OSCIL IS NOW THE NOSCIL...JMG 7/14/73

; SOMEDAY, IF IT IS EVER USED, SOMEONE COULD CHANGE
; THE NAME OF NOSCA TO OSCA, ETC. 
;TMPS12:	TMNOSA	
;	PUT1 6,NOSCI
;	XWD UGBIT,.+3
;	PUT2 L
;	0
;	JSP RA,@NOSCIL
;	BYTE (6)4,2,2,1,4,0,1

TMNOSA:	TMPS13
	PUT1 5,NOSCA
	XWD UGBIT,.+2
	JSA RA,INOSCA
	JSP RA,@NOSCA
	BYTE (6)5,2,2,2,1,5,0,T

;TMPS13:	TMPS14
;	PUT1 10,DISKF
;	XWD VRBLBT,DISKFL
;	PUT2 LAG
;DISKFL:	0

TMPS13:	TMPS15
	PUT1 5,INTRP
	XWD UGBIT,.+2
	JSA RA,IINTRP
	JSP RA,@INTRP
	BYTE (6)5,2,2,5,1,4,0,T
;TMPS24:	TMPS14
;	PUT1 4,READ
;	XWD UGBIT,.+2
;	JSP RA,READI
;	JSP RA,@READ
;	BYTE (6)6,2,2,1,2,5,5,0,T
;TMPS14:	TMPS15
;	PUT1 4,REVX
;	XWD UGBIT,.+2
;	JSP RA,REVXI
;	JSP RA,@REVX
;	BYTE (6)20,2,2,2,2,2,2,2,2,2,4,4,4,4,4,1,4,0,T

TMPS15:	.+3
	PUT1 4,OUTA
	XWD VRBLBT,OUTA
;	.+3
;	PUT1 4,OUTB
;	XWD VRBLBT,OUTB
;	.+3
;	PUT1 4,OUTC
;	XWD VRBLBT,OUTC
;	.+4	;DOPLAY←1=WILL PLAY WHEN WRITING SMPLS ON DSK
;	PUT1 6,DOPLA
;	XWD VRBLBT,DOPLAY#
;	PUT2 Y
;	.+3
;	PUT1 4,OUTD
;	XWD VRBLBT,OUTD
	.+4	;RCDFLG←1 PUTS SAMPLES ON DSK UNDER 'MUSAA','MUSAB',ETC.
	PUT1 6,RCDFL
	XWD VRBLBT,RCDFLG#
	PUT2 G
;	.+4
;	PUT1 6,BIGBI
;	XWD VRBLBT,BIGBIT#
;	PUT2 T
;	.+6
;	PUT1 5,VALUE
;	XWD UGBIT,.+2
;	0
;	JSP RA,@VALUE
;	BYTE (6)1,2,0,T
	.+5
	PUT1 4,RAND
	XWD FUNBIT,.+1
	PUSHJ P,RAND
	BYTE (6)0,T
;S	FRSTB+1
;S	PUT1 =9,FIRST
;S	XWD VRBLBT,FRSTB
;S	PUT2 BAND
;SFRSTB:	0
	.+5
	PUT1 5,PRINT
	XWD FUNBIT,.+1
	JSA RA,FOOPRT
	BYTE (6)1,2,0,0
;	.+3
;	PUT1 3,RDA
;	XWD RVBT∨VRBLBT,RDA
;	.+3
;	PUT1 3,RDB
;	XWD RVBT∨VRBLBT,RDB
;	.+3
;	PUT1 3,RDC
;	XWD RVBT∨VRBLBT,RDC
;	.+3
;	PUT1 3,RDD
;	XWD RVBT∨VRBLBT,RDD

TMPSA:	EXP TMPS4	;LINEN.
	PUT1 5,LINEN
	XWD UGBIT,.+2
	JSA RA,LINEN1
	JSP RA,@LINEN
;	BYTE (6)13,4,4,4,2,2,2,2,1,4,4,4,0,1
	BYTE (6)13,4,4,4,2,2,2,2,1,2,4,4,0,1  
;NOW YOU MUST RESET PTR IN LINEN
TMPS4:	EXP TMPS4A
;TMPS4:	EXP TMPS5
	PUT1 5,EXPEN
	XWD UGBIT,.+2
	0
	JSP RA,@EXPEN
	BYTE (6)4,2,2,1,4,0,1

TMPS4A:	EXP TMPS8
	PUT1 6,ZEXPE
	XWD UGBIT,.+3
	PUT2 N
	0
	JSP RA,@ZEXPEN
	BYTE (6)4,2,2,1,4,0,1

;TMPS5:	EXP TMPS6
;	PUT1 (4,REV1)	;REV1
;	XWD UGBIT,.+2
;	JSP RA,REVI
;	JSP RA,@REV1
;	BYTE (6)6,2,2,2,1,5,4,0,1
;TMPS6:	EXP TMPS7
;	PUT1 4,REV2
;	XWD UGBIT,.+2
;	JSP RA,REVI
;	JSP RA,@REV2
;	BYTE (6)6,2,2,2,1,5,4,0,1

;TMPS7:	EXP TMPS8
;	PUT1 (7,REVIN)	;REVINIT.
;	XWD VRBLBT,REVINI
;	PUT2 IT
;REVINI:	0

TMPS8:	EXP TMPS9
	PUT1 (5,RANDH)
	XWD UGBIT,.+2
	JSP RA,IRANDH
	JSP RA,@RANDH
	BYTE (6)4,2,2,4,4,0,1
TMPS9:	EXP TMPS10
	PUT1 (5,RANDI)
	XWD UGBIT,.+2
	JSP RA,IRANDI
	JSP RA,@RANDI
	BYTE (6)5,2,2,4,4,4,0,1
TMPS10:	EXP A-1
	PUT1 6,COSCI
	XWD UGBIT,.+3
	PUT2 L
	0
;	JSP RA,@NOSCIL
	JSP RA,@OSCIL
	BYTE (6)4,2,2,1,5,0,1


;; HERE ARE SOME WONDERFUL UNIT GENERATORS.

; THIS IS THE OLD OSCIL WHICH DOESN'T LIKE NEG. INCS.
;OSCIL:	MOVE INSXR,3(RA)
;	FIX INSXR,233000
;	TRZE INSXR,777000
;	JSP T1,OSCIL1
;	MOVE T,@2(RA)
;	FMPR T,@(RA)
;	SKIPGE T1,@1(RA)	;OSCIL DOESN'T WANT NEG. INC.
;	ERROR (NEGATIVE INC. TO OSCIL)
;	FADM T1,3(RA)
;	JRST 4(RA)
NOSCA:	ADDI RA,1
;NOSCIL:	MOVE INSXR,3(RA)
OSCIL:	MOVE INSXR,3(RA)
;;*** CAUSE OF ROUNDOFF PROBS????	FAD INSXR,[0.5]
;;	HRLZI T1,233000
;;	UFA T1,INSXR
;  THE ABOVE 2 INST'S REPLACE THE FIX FOR INDEXING
	FIX INSXR,233000
	TRZE INSXR,777000
	JSP T1,OSCIL1
	MOVE T,@2(RA)
	FMPR T,@(RA)
	MOVE T1,@1(RA)
	FADM T1,3(RA)
	JRST 4(RA)
OSCIL1:	MOVSI (-512.0)	;WRAP AROUND THE POINTER.
	JUMPGE INSXR,.+2
	MOVNS 0		;IF NEG. INC., WRAP AROUND OTHER WAY.
	FADM 3(RA)
	HRLI INSXR,0	;TO ALLOW ZOSCIL=NOSCIL
	JRST (T1)

OUT:	0
	MOVE @(RA)	;PICK UP INPUT.
	FADM OUTA	;ACCUMULATE INTO OUTPUT ARRAY.
	POPJ P,		;RETURN FROM INSTRUMENT.

OUT2:	0
	MOVE @(RA)
	MOVE 1,0
	FMP @1(RA)
	FADM OUTA	;
;	FMP 1,@2(RA)
;	FADM 1,OUTB
	POPJ P,

EXPEN:	MOVE INSXR,@1(RA)	;GET INCREMENT.
	FADB INSXR,3(RA)	;INCREMENT POINTER.
	FIX INSXR,233000
;;	HRLZI T1,233000
;;	UFA T1,INSXR
;	CAIL INSXR,777	;IF GREATER THAN 512, STICK
	TRZE INSXR,777000
EXPEN2:	MOVEI INSXR,777	;AT LAST ELEMENT OF ARRAY.
	MOVE T,@2(RA)	;GET ARRAY ELEMENT.
	FMPR T,@(RA)	;MULTIPLY BY AMPLITUDE.
	JRST 4(RA)	;RETURN.
VFM2:	FSBR INSXR,[512.0]	;YOU MUST NOW SET PTR FOR VFMULT!
	MOVEM INSXR,@VFMULT

VFMULT:	MOVE INSXR,@1(RA)	;GET POINTER INPUT.
	CAML INSXR,[512.0]
	JRST VFM2
	FIX INSXR,233000
;;	HRLZI T1,233000
;;	UFA T1,INSXR
	MOVE T,@2(RA)	;GET INDICATED ELEMENT OF ARRAY.
	FMPR T,@(RA)	;MULT. BY AMPLITUDE.
	JRST 3(RA)

INOSCA:	0
	MOVE T,(RA)
	MOVE T1,@-6(T)
	MOVEM T1,-2(T)
	JRA RA,1(RA)
INTRP:	ADDI RA,1
	MOVE INSXR,3(RA)
	FIX INSXR,233000
;;	HRLZI T1,233000
;;	UFA T1,INSXR
	TRZE INSXR,777000
	JSP T1,OSCIL1
	MOVE T,@2(RA)
	FMPR T,@(RA)
	FADR T,@-1(RA)
	MOVE T1,1(RA)
	FADM T1,3(RA)
	JRST 4(RA)

IINTRP:	0
	MOVE T,(RA)
	MOVE T1,@-5(T)
	FSBR T1,@-6(T)
	MOVEM T1,@-5(T)
	MOVSI T1,(512.0)
	FDVR T1,SRATE
	FDVR T1,PBASE+2
	MOVEM T1,-4(T)
	JRA RA,1(RA)

ZEXPEN: SKIPGE INSXR,3(RA)	;ZEXPEN WORKS LIKE ZOSCIL AND EXPEN!
	JRST[   ERROR (NEGATIVE INC. TO ZEXPEN)
		JSP T1,OSCIL1		;DO WRAPAROUND ANYWAY
		JRST .+1]		;LET THE LOSER CONTINUE
;  IT TAKES THESE 4 INST'S TO DO A GOOD FIX FOR FURTHER USE
	FIX INSXR,233000
;;	HRLZI T1,233000
;;	UFA T1,INSXR
;;	JUMPE INSXR,.+2
;;	TLC INSXR,233000
	CAIL INSXR,777		;IF GREATER THAN 511, STICK
	JRST EXPEN2		;AT LAST ELEMENT (WE WON'T NEED TO INTERPOLATE)
	MOVE T,@2(RA)		;PICK UP FIRST ELEMENT
	move insxr		;SAVE INDEX
	move t1,t		;COPY FIRST ELEMENT
	addi insxr,1		;NO, INCREMENT INDEX
	fsbr t1,@2(ra)		;GET DWFFERENCE IN VALUE I
	fsc 233			;(FLOAT THE INDEX)
	fsb 3(ra)		;GET DIFFERENCE IN INDEX INTO 0
	fmpr t1,0		;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
	fadr t,t1		;IS ADDED TO THE FIRST ELEMENT
	FMPR T,@(RA)		;SCALED BY AMPLITUDE
	MOVE T1,@1(RA)		;UPDATE SUM OF INCREMENTS
	FADM T1,3(RA)
	JRST 4(RA)

ZINTRP: ADDI RA,1		;AN INTERPOLATING INTRP!
	MOVE INSXR,3(RA)
	FIX INSXR,233000
;;	HRLZI T1,233000
;;	UFA T1,INSXR
;;	JUMPE INSXR,.+2
;;	TLC INSXR,233000
	TRZE INSXR,777000	;DID WE RUN OVER?
	JSP T1,OSCIL1		;YES, DO WRAPAROUND (BUT IT REALLY SHOULDN'T!)
	MOVE T,@2(RA)		;PICK UP FIRST ELEMENT
	move insxr		;SAVE INDEX
	move t1,t		;COPY FIRST ELEMENT
	cain insxr,777		;ARE WE AT THE LAST ELEMENT
	tdza insxr,insxr	;YES, SET INDEX TO ZERO AND SKIP
	addi insxr,1		;NO, INCREMENT INDEX
	fsbr t1,@2(ra)		;GET DIFFERENCE IN VALUE I
	fsc 233			;(FLOAT THE INDEX)
	fsb 3(ra)		;GET DIFFERENCE IN INDEX INTO 0
	fmpr t1,0		;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
	fadr t,t1		;IS ADDED TO THE FIRST ELEMENT
	MOVE @(RA)		;GET SECOND VALUE
	FSBR @-1(RA)		;SUBTRACT THE FIRST
	FMPR T,0		;MULIPLY BY DIFFENCE BETWEEN TWO VALUES
	FADR T,@-1(RA)		;AND ADD TO THE FIRST VALUE
	MOVE T1,1(RA)		;UPDATE SUM OF INCREMENTS
	FADM T1,3(RA)
	JRST 4(RA)

;READ:	AOS INSXR,4(RA)
;	CAML INSXR,5(RA)
;	JRST READ1
;	MOVEI T,0
;LCS2:	MOVE @2(RA)
;	MOVEM RDA(T)
;	ADDI T,1
;	CAML T,3(RA)
;	JRST 7(RA)
;	AOS INSXR,4(RA)
;	JRST LCS2

;READ1:	MOVE 2(RA)
;	MOVEM LCS+3	
;	SUBI 1
;	HRRZM LCS+4	
;LCS:	JSA 16,READIN
;	0
;	0
;	0
;	0
;	[-1]
;	SETZB INSXR,4(RA)
;	JRST READ+3

;READI:	MOVE T,(RA)
;	MOVE T2,@-4(T)
;	FIX T2,233000
;******↑↑↑↑↑↑ OK FOR EXPORT ????? 5/74
;	MOVEM T2,-4(T)
;	MOVE T2,-7(T)
;	MOVEM T2,LCS1+1
;	MOVE T2,-6(T)
;	MOVEM T2,LCS1+2
;	MOVE T1,-5(T)
;	MOVE T2, -1(T1)
;	MOVEM T2,-2(T)
;	SETOM -3(T)
;	MOVEM T1,LCS1+3
;LCS1:	JSA RA,READIN
;	0
;	0
;	0
;	T2
;	[0]
;	JRST 1(RA)

ZOSCIL:	MOVE INSXR,3(RA) ;ZOSCIL WORKS LIKE COSCIL AND NOSCIL!
	FIX INSXR,233000
;;	HRLZI T1,233000
;;	UFA T1,INSXR
;;	JUMPE INSXR,.+2
;;	TLC INSXR,233000
	TRZE INSXR,777000
	JSP T1,OSCIL1
	MOVE T,@2(RA)
	move insxr
	move t1,t
	cain insxr,777
	tdza insxr,insxr
	addi insxr,1
	fsbr t1,@2(ra)
	fsc 233
	fsb 3(ra)
	fmpr t1,0
	fadr t,t1
	FMPR T,@(RA)
	MOVE T1,@1(RA)
	FADM T1,3(RA)
	JRST 4(RA)


;;  REVERBERATION UNIT GENERATORS.
; REV1 IS THE SIMPLE FED-BACK DELAY LOOP, OR 'COMB FILTER'.

;REV1:	AOS INSXR,4(RA)	;INCREMENT OUTPUT PTR.
;	CAML INSXR,5(RA)	;IS IT TIME TO WRAP AROUND ?
;	SETZB INSXR,4(RA)	;YES.
;	MOVE 1,@3(RA)	;GET OUTPUT OF DELAY LINE.
;	MOVE 2,1	;LEAVE IN 1 AS FINAL OUTPUT.
;	FMPR 2,@2(RA)	;MULTIPLY BY FEEDBACK GAIN.
;REVA:	MOVE @1(RA)	;GET DELAY TIME, T.
;	FIX 233000
;	ADD INSXR,0	;MOVE PTR. AROUND TO INPUT END.
;	CAML INSXR,5(RA)	;PROBABLY HAVE TO WRAP AROUND..
;	SUB INSXR,5(RA)	;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
; THE ABOVE 5 INSTRUCTIONS ALLOW A DYNAMICALLY CONTROLLED
; DELAY TIME IN REVERB. TO INSTITUTE, CHANGE THE LOC. OF
; 'REVA:' BACK TO ABOVE AND DE-COMMENT. THE PRESENT REVERB
; ASSUMES THAT THE ARRAY LENGTH IS THE DELAY, SO THE ARGU-
; MENT IN THE UG IS IGNORED... JMG 7/14/73
;REVA:   FADR 2,@(RA)	;ADD IN THE INPUT SAMPLE.
;	JFCL 1,[SETZB 2,1	;FLOAT. UNDER FLOW
;		SETOM FXUFLG#
;		JRST .+1]	;THESE WERE ON JC,MUS. WHY???
;	MOVEM 2,@3(RA)	;PLACE IN INPUT OF DELAY LINE.
;	JRST 6(RA)	;RETURN.

;REV2 IS THE ALL-PASS REVERBERATOR.

;REV2:	AOS INSXR,4(RA)	;CALC. PTR. AS IN REV1.
;	CAML INSXR,5(RA)
;	SETZB INSXR,4(RA)
;;	MOVN 1,@3(RA)	;GET NEGATIVE OF OUTPUT OF DELAY.
;;	MOVN 0,@2(RA)	;ALSO NEGATIVE OF GAIN, G.
;;	FMPR 1,0	;FORM GAIN*OUTPUT
;;	MOVE 2,1	;(NOTE THIS IS POSITIVE).
;;	FMPR 1,0	;FORM -G↑2 * OUTPUT.
;;	FADR 1,@3(RA)	;(1-G↑2) * OUTPUT.
;;	FMPR 0,@(RA)	;FORM -G * INPUT.
;;	FADR 1,0	;FINAL OUTPUT IS -G*IN +(1-G↑2)*OUT.
;;	JRST REVA	;FROM HERE ON, SAME AS REV1.
;	MOVE 2,@2(RA)	;GET GAIN, G
;	FMPR 2,@(RA)	;MULTIPLY BY INPUT
;	FADR 2,@3(RA)	;ADD IN OUTPUT OF DELAY
;	MOVN 1,2	;TAKE -(OUTPUT+G+IN)
;	FMPR 1,@2(RA)	;SCALE BY GAIN
;	FADR 1,@(RA)	;ADD INPUT
;	JFCL 1,[SETZB 2,1	;FLOATING UNDERFLOW
;		SETOM FXUFLG#
;		JRST .+1]
;	MOVEM 1,@3(RA)	;NEW DELAY INPUT
;	JRST 6(RA)	;RETURN WITH ANSWER IN 2
;  NEW REV. 1 LESS MULT.  A.MOORER, 5/74

;  THIS IS THE I-TIME CODE FOR REV1 AND REV2.

;REVI:	HRRZ T1,(RA)	;GET PTR. TO END OF REV PARAMS.
;	MOVNI INSXR,1	;INSXR←-1
;	HRRZ @-4(T1)	;GET -1ST ELEMENT OF ARRAY (THE LENGTH)
;	MOVEM -2(T1)	;PLACE IN THE SECOND DUMMY PARAM.
;	SKIPN REVINI	;SHOULD WE INIT. THE DELAY ARRAY ?
;	JRST 1(RA)	;NO.
;	SETZM -3(T1)	;YES. FIRST CLEAR THE POINTER LOC.
;	HRRZ T,-4(T1)	;GET PTR. TO ARRAY.
;REVI2:	ADDI -1(T)	; 0 NOW POINTS TO TOP OF ARRAY.
;	HRL T,T
;	SETZM (T)	;CLEAR FIRST ELEMENT OF ARRAY.
;	ADDI T,1	;FORM BLT POINTER.
;	BLT T,@0	;CLEAR REST OF ARRAY.
;	JRST 1(RA)


;; MORE GENERATORS.

LINEN:	MOVE INSXR,11(RA)	;GET INCREMENT.
;	FADB INSXR,10(RA)	;ADD TO POINTER.
	FADB INSXR,@10(RA)	;NOW YOU MUST RESET PTR
LINEN4:	CAML INSXR,12(RA)	;ARE WE PAST END OF SECTION ?
	JRST LINEN2		;YES.
	FIX INSXR,233000
	MOVE T,@3(RA)		;AMPLITUDE.
	FMPR T,@7(RA)		;MULT. BY ARRAY ELEMENT.
	JRST 13(RA)	;RETURN.

LINEN2:	MOVE T,12(RA)	;PICK UP CURRENT LIMIT.
	FIX T,242000
	CAIL T,3	;END OF ARRAY ?
	JRST LINEN3	;YES.
	HRLI T,RA	;PREPARE FOR INDEXING...
	MOVE @T		;PICK UP NEXT INCREMENT.
	MOVEM 11(RA)	;PUT AWAY.
	MOVSI (128.0)
	FADM 12(RA)	;INCREMENT LIMIT TO NEXT VALUE.
	JRST LINEN4
LINEN3:	MOVEI 14(RA)	;FAKE UP A PARAMETER FOR LINEN1.
	MOVEM .+2
	JSA RA,LINEN1	;RE-INITIALIZE THE GENERATOR.
	0		;
;	SETZM 10(RA)	;RESET PTR.
	SETZM @10(RA)	;NOW YOU MUST RESET PTR
	SETZM 11(RA)	;AND INCREMENT.
	SETZM 12(RA)	;...AND LIMIT.
	JRST LINEN

LINEN1:	0	;THE INITIALIZING CODE FOR LINEN.
	MOVE T2,(RA)	;GET POINTER TO END OF PARAMETERS.
	MOVE T1,TIMESC	;CALC. 128*(BEATS/SAMPLE)
	FDVR T1,SRATE
	FSC T1,7
	MOVE T,@-10(T2)	;GET RISE TIME IN BEATS.
	FDVRM T1,T	;INCREMENT←T1/TIME (=128/(TIME IN SAMPS))
	MOVEM T,-14(T2)	;PLACE IN PARAMETER 0.
	MOVE T,@-6(T2)	;DURATION OF NOTE IN BEATS...
	FSBR T,@-7(T2)	;...MINUS FALL TIME..
	FSBR T,@-10(T2)	;...MINUS RISE TIME.
	FDVRM T1,T	;CHANGE TO INCREMENT.
	MOVEM T,-13(T2)	;PLACE IN PARAMETER 1.
	FDVR T1,@-7(T2)	;INCREMENT FOR FALL TIME.
	MOVEM T1,-12(T2)	;PLACE IN PARAMETER 2.
	JRA RA,1(RA)

;VALUE:	MOVE T,@(RA)	;DUMMY UNIT GENERATOR... OUTPUT IS
;	JRST 1(RA)	;SAME AS ITS PARAMETER.

;;  RANDOM NUMBER GENERATORS.

RANDH:	MOVE @1(RA)	;GET INCREMENT.
	FADB 2(RA)	;INCREMENT THE 'POINTER'.
	CAML [512.0]	;OVER 512 ?
	JRST RNDH2	;YES. GO GET NEW RANDOM NUMBER.
	MOVE T,@(RA)	;NO. GET INPUT ...
	FMPR T,3(RA)	;... AND MULT. BY CURRENT RANDOM NO.
	JRST 4(RA)	;RETURN.
RNDH2:	MOVSI (-512.0)	;CAUSE 'POINTER' TO 'WRAP AROUND'.
	FADM 2(RA)
	PUSHJ P,RAND	;GET NEW RANDOM NO.
	MOVEM T,3(RA)	;MAKE IT THE CURRENT NO.
	FMPR T,@(RA)	;MULT. BY INPUT.
	JRST 4(RA)	;RETURN.

IRANDI:		;I-TIME CODE FOR RANDI AND RANDH.
IRANDH:	PUSHJ P,RAND	;INIT. RANDH.
	MOVE T2,(RA)	;GET PTR. TO LAST PARAM..
	MOVEM T,-2(T2)	;PUT INITIAL RAND. NO. IN.
	JRST 1(RA)

RANDI:	MOVE T,2(RA)	;GET CURRENT DELTA..
	FADRB T,4(RA)	;ADD TO LAST OUTPUT VALUE...
	SOSG 3(RA)	;DECREMENT STEP COUNTER ...
	JRST RNDI2	;IT'S 0, SO GET NEW RANDOM NO.
	FMPR T,@(RA)	;NO.  MULT BY INPUT.
	JRST 5(RA)	;RETURN.
RNDI2:	PUSHJ P,RAND	;GET NEXT RANDOM NO.
	FSBR T,4(RA)	;FORM DELTA (=NEW  - OLD)
	MOVSI T1,(512.0)
	FDVR T1,@1(RA)	;NO. OF STEPS = 512/(FREQ. INPUT)
	FDVR T,T1	;CHANGE PER STEP =DELTA/NO. OF STEPS
	MOVEM T,2(RA)	;STORE CHANGE PER STEP.
	FIX T1,233000
;**********↑↑↑↑↑↑↑
	MOVEM T1,3(RA)	;PUT IT AWAY.
	JRST RANDI	;NOW GO GENERATE FIRST STEP.

RAND:	MOVE T,RNDNO1	;GENERATE A RANDOM NO.
	ADD T,RNDNO2
	EXCH T,RNDNO2
	MOVEM T,RNDNO1
	ASH T,-10	;SMEAR  SIGN INTO EXPONENT FIELD..
	FSC T,200	;... AND FLOAT IT IN RANGE -1 TO 1.
	POPJ P,
RNDNO1:	 756132257563
RNDNO2: 756132257565

PLIST:	BLOCK LPLIST

OSTK:	BLOCK LOSTK

RQ1:	BLOCK LRQ	;THE RUN QUEUE, CLOUMN ONE.
RQ2:	BLOCK LRQ	;COLUMN TWO.

PATCH:	BLOCK 100

IARR1:		;; HERE BEGINS AN AREA WHICH IS ZEROED DURING
	; INITIALIZATION OF EACH COMPILATION.

UOTBL:	BLOCK LUOTBL

ACS:
RACS:	BLOCK 20
IACS:	BLOCK 20

UOPTR:	-1

IARR2:

PBASE:	BLOCK LPA

OUTA:	0	;CHANNEL A OUTPUT SAMPLE ACCUMULATED HERE.
;OUTB:	0	;CHANNEL B.
;OUTC:	0	;CHANNEL C.
;OUTD:	0	;CHANNEL D.

;RDA:	0
;RDB:	0
;RDC:	0
;RDD:	0

IARR3:


VLOC:	0
ILOC:	0
RLOC:	0

DSKMAX:	=76*2000*17

;; THIS IS THE MULTIPLE-FEEDBACK REVERBERATOR.
;;  ITS DELAY TIMES MUST NOT BE R-TIME VARIABLES.

;REVX:	SOSGE INSXR,15(RA)	; ADVANCE PTR. TO 4TH TAP.
;	JSP T1,REVX1	;TIME TO WRAP AROUND....
;	MOVE T,@16(RA)	;GET DELAY ARRAY OUTPUT FROM 4TH TAP..
;	FMP T,@10(RA)	;MULT. BY GAIN NO. 4
;	SOSGE INSXR,14(RA)	;NOW PTR. TO 3RD TAP.
;	JSP T1,REVX1
;	MOVE @16(RA)	;... 3RD TAP DELAY OUTPUT...
;	FMP @6(RA)	;...3RD GAIN...
;	FAD T,0	;ACCUMULATE SUM IN T.
;	SOSGE INSXR,13(RA)	;2ND TAP PTR.
;	JSP T1,REVX1	;THIS COULD GET BORING.
;	MOVE @16(RA)
;	FMP @4(RA)	;GAIN 2.
;	FAD T,0
;	SOSGE INSXR,12(RA)	;ONE MORE CHORUS.
;	JSP T1,REVX1
;	MOVE @16(RA)
;	FMP @2(RA)	;GAIN 1.
;	FADB T,0	;T NOW HAS FINAL OUTPUT(=SUM OF
			;          TAPS * GAINS).
;	FAD @(RA)	;ADD OUTPUT TO INPUT ..
;	SOSGE INSXR,11(RA)	;.. GET PTR. TO INPUT OF DELAY..
;	JSP T1,REVX1
;	MOVEM @16(RA)	;AND PUT IT THERE.
;	JRST 20(RA)	;WOULD YOU BELIEVE 20 PARAMETERS ??!

;REVX1:	ADD INSXR,17(RA)	;A PTR. HAS UNDERFLOWED; ADD 
;	MOVEM INSXR,@-2(T1)	; LENGTH OF ARRAY TO IT TO WRAP
;	JRST (T1)	;IT AROUND (AND STORE UPDATED VERSION).


;REVXI:	MOVE T1,(RA)	;INITIALIZING FOR REVX.. GET PTR. TO PARAMMS.
;	MOVNI INSXR,1
;	MOVE @-3(T1)	;GET -1ST ELEMENT OF ARRAY (= ITS LENGTH).
;	MOVEM -2(T1)	;STORE IN LAST DUMMY PARAM.
;	SKIPE REVINI	;IF WE ARE INITIALIZING REVERBERATORS,
;	SETZM -10(T1)	;RESET INPUT PTR. OF DELAY TO BOTTOM OF ARRAY.
;	MOVSI T,-4	;NOW WE SET UP THE FOUR DELAY OUTPUT TAP
;	HRRI T,-7(T1)	;PTRS. THE RIGHT DISTANCE BEHIND THE INPUT PTR.
;	MOVEI T2,-20(T1)	;
;REVXI2:	MOVE @(T2)	;PICK UP DELAY TIME (IN SAMPLES).
;	FIX 233000
;**********↑↑↑↑↑↑↑↑
;	ADD -10(T1)	;ADD TO INPUT PTR. POSITION.
;	CAML -2(T1)	;WRAP AROUND ?
;	SUB -2(T1)	;YES. SUB. LENGTH OF ARRAY.
;	MOVEM (T)	;PLACE PTR. IN RIGHT DUMMY PARAM.
;	ADDI T2,2	;INC. T2 TO POINT AT NEXT DELAY TIME PARAM.
;	AOBJN T,REVXI2	;LOOP TO GET ALL 4 DELAY TAPS.
;	SKIPN REVINIT	;ARE WE INITIALIZING REVERBERATORS ?
;	JRST 1(RA)	;NO. RETURN.
;	MOVE -2(T1)	;YES GET LENGTH OF ARRAY.
;	HRRZ T,-3(T1)	;GET BASE OF ARRAY.
;	JRST REVI2	;GO ZERO ARRAY (SEE REV1 AND REV2 PAGE).

	; ***** COMPX BEGINS HERE ****  ROUTINES TO EMIT CODE AND STUFF TO OUTPUT BUFFERS.
EMDV:	SETZB A,B	;EMIT A DUMMY VARIABLE (TO RESERVE 
			; SPACE IN THE VARIABLES AREA).
EMVCDI:	AOS VLOC
EMVCD:	MOVEI T1,2	;EMIT TO VARIABLE BUFFER.
	JRST ECD
EMIABS:	TDZA B,B	;EMIT TO I-TIME BUF. , NO RELOC.
EMCDI:	AOSA RLOC	;SKIP INSTRUCTIONS WIN BIG.
EMICDI:	AOSA ILOC	; SEE THE HAPPY INTERLEAVED CODE !
EMCD:	TDZA T1,T1	;EMIT TO RUNTIME BUFFER.
EMICD:	MOVEI T1,1	;EMIT TO INITIALIZE TIME BUFFER.
ECD:
	IDPB A,EMPTR(T1)	;EMIT THE WORD.
	IDPB B,RELPTR(T1)	;ALSO ITS RELOCATION BITS.
	AOSGE BUFCNT(T1)	;IS BUFFER FULL ?
	POPJ P,		;NO. RETURN.

GBUF:	;	BUFFER IS FULL; GET A NEW ONE.
	MOVNI T,LOBUFS	;LENGTH OF A BUFFER.
	PUSHJ P,GFS	;GET SOME FREE STORAGE(WHILE IT LASTS!)
	HRLI T,400	;MAKE BYTE PTR.
	MOVEM T,RELPTR(T1)	;PTR. FOR RELOCATION BITS.
	MOVEI T2,LOBUFS/12+2(T)	;LEAVE ROOM FOR REL. BITS
	HRRM T2,EMPTR(T1)	;DATA PTR.
	HRRZM T,@OBPTR(T1)	;FIX UP FORWARD LINKS.
	HRRZM T,OBPTR(T1)
	SETZM @OBPTR(T1)
	MOVNI LOBUFS-LOBUFS/12-3
	MOVEM BUFCNT(T1)	;SET UP WORD COUNT.
	POPJ P,

EMPTR:	POINT 36,0,35	;DATA OUTPUT POINTERS.
EMIPTR:	POINT 36,0,35
EMVPTR:	POINT 36,0,35
RELPTR:	POINT 4,0	;RELOC. BITS PTRS.
RELIPT:	POINT 4,0
RELVPT:	POINT 4,0

OBPTR:	BLOCK 3	;PTR. TO FIRST WORD OF CURRENT BUFFER FOR
		; USE IN FIXING UP FORWARD LINKS.
BUFCNT:	BLOCK 3	;WORD COUNTS FOR BUFFERS.

FCBUF:	0	;PTR. TO FIRST BUFFER IN EACH CHAIN.
FICBUF:	0
FVCBUF:	0

GFS:	ADD T,JOBSYM	;DECREMENT BOTTOM OF FREE STORAGE.
	HRRZ JOBFF
	CAIL (T)	;ROOM LEFT ?
	ERROR (STORAGE FULL)	;NO.
	MOVEM T,JOBSYM
	POPJ P,

	;THIS HERE IS THE COMPILER !
; RECURSIVE EXPRESSION ANALYZER.

SEXPR:	PUSHJ P,SCAN
EXPR:	PUSHJ P,TERM	;<EXPR> = <TERM> ! <TERM><ADDOP><EXPR>
EXPR1:	TLNE A,DF	;A DELIMITER NEXT ?
	TLNN A,ADDBIT	;YES. AN ADD OR SUBTRACT OP. ?
	POPJ P,		;NO.
	PUSH P,A	;YES. LOOK FOR ANOTHER TERM.
	PUSHJ P,STERM	;THIS IS ITERATIVE INSTEAD OF
		; RECURSIVE IN ORDER TO PROCESS FROM LEFT TO
	EXCH A,(P)	; RIGHT.
	PUSHJ P,(A)	;CALL APPROPRIATE GENERATOR.
	POP P,A
	JRST EXPR1

STERM:	PUSHJ P,SCANV
TERM:	PUSHJ P,FACTOR	;<TERM>=<FACTOR>!<FACTOR><MULOP><FACT.>
TERM1:	TLNE A,DF	;A DELIMITER NEXT ?
	TLNN A,MULBIT	;YES. A MULTIPLY OR DIVIDE OP ?
	POPJ P,		;NO.
	PUSH P,A
	PUSHJ P,SFACTOR
	EXCH A,(P)
	PUSHJ P,(A)
	POP P,A
	JRST TERM1

SFACTOR:PUSHJ P,SCANV
FACTOR:	JRST PRIMARY	;GOOD ENOUGH FOR NOW ...

SPRIM:	PUSHJ P,SCAN
PRIMARY:
	JUMPE A,UDIERR	;STILL UNDEFINED ?
	TLNN A,DF	;IS IT A SPECIAL CHAR. ?
	JRST PRIM3	;NO.

PRIM2:	CAMN A,MINV	;UNARY MINUS ?
	JRST PRUMIN	;YES.
	CAME A,LPARV	;NO. IT BETTER BE A (.
	ERROR (ILLEGAL PRIMARY.)
	PUSHJ P,SEXPR	;SCAN AN EXPRESSION.
	CAME A,RPARV	;LOOK FOR MATCHING PAREN.
	ERROR (MISSING RIGHT PAREN.)
	JRST SCAN	;SCAN AND RETURN.

PRUMIN:	PUSHJ P,SPRIM	;UNARY MINUS; SCAN A PRIMARY.
	PUSH P,A
	PUSHJ P,UMGEN	;CALL GENERATOR.
	JRST POPAJ	;RESTORE A AND RETURN.

PRIM3:	TLNN A,FUNBIT	;THE NAME OF A FUNCTION ?
	JRST SVRBL	;NO.
PRFUN:	PUSHJ P,FUNCAL	;COMPILE THE FUNCTION CALL.
	PUSHJ P,MRKAC0	;MARK AC0 FULL (VALUE OF FUNCTION).
	JRST SCAN	;RETURN.

SVRBL:	TLNN A,VRBLBT!SWVBT!NUMFLG!FOOBIT	;SHOULD BE A VARIABLE,ARRAY NAME,NUMBER OR FOO SYM.  
	ERROR (ILLEGAL PRIMARY)
	TLNE A,VRBLBT!NUMFLG!FOOBIT	;IS IT AN ARRAY NAME ?
	JRST SVRBL2	;NO.
	HRR A,(A)	;YES. GET R. HALF OF GOOD BITS.
	SUBI A,2	;MAKE IT POINT TO ARRAY[-2].
SVRBL2:	PUSH OSP,A	;MAY BE AN ASN. STMT....
	TLNE A,NUMFLG+SWVBT	;IF IT IS A NUMBER, IT CAN'T BE
	JRST SCAN	;LEFT PART OF ASN. STMT.
SVRBL1:	PUSHJ P,SCAN	;GET LEFT ARROW,IF ANY.
	CAME A,LARV	;IT IS ONE, ISN'T IT ?
LAROW:	POPJ P,	;NOPE. JUST A GARDEN VARIETY VARIABLE.
	PUSHJ P,ASTMT1	;YES. COMPILE IT.
	PUSHJ P,MRKAC	;SINCE ITS A PRIMARY, REMEMBER ITS
	JRST POPAJ	;VALUE, THEN RETURN.
ASTMT1:	  ;; COMPILE ASSIGNMENT STMT...
	PUSHJ P,SEXPR	;COMPILE RIGHT PART OF STMT.
	EXCH A,(P)	;SAVE 'A' UNDERNEATH RETURN ADR.
	PUSH P,A
	JRST ASNGEN	;GENERATE THE STORE.

; PROCESS A FUNCTION CALL.

FUNCAL:	PUSH P,RLOC	;SAVE R-TIME CODE LOC. CTR.
	HRRZ B,(A)	;GET PTR. TO PARAMETER DESCRIPTORS.
	PUSH P,B	;PTR. TO SYMTABLE ENTRY.
	PUSH OSP,(B)	;PLACE CALLING INSTR. ON OPND. STK.
	PUSH P,[POINT 6,0,35]	;MAKE A PTR. TO THE BYTES
	HRRM B,(P)	; OF THE PARAMETER DESRIPTION.
	ILDB T,(P)	;GET PARAMTER COUNT.
	PUSH P,T
	JUMPE T,FNOPR	;IF NO PARAMS., CALL GENERATOR.
	PUSHJ P,SCAN	;SWALLOW LEFT PAREN.
	CAME A,LPARV	;I HATE PEOPLE WHO DO THIS.
	ERROR (MISSING LEFT PAREN.)
	PUSHJ P,SCAN	;SCAN FIRST PARAM.
FUNC4:	PUSH P,A
FUNC1:	ILDB T,-2(P)	;GET NEXT PARAM. DESCRIPTOR.
	CAIN T,FDPARB	;IS IT A DUMMY PARAM. ?
	JRST FDPAR	;YES.
	CAIN T,FDPARC	;OR A TYPE 2 DUMMY ?
	JRST FDPAR2	;YES.
	POP P,A		;NO.
	JUMPE T,FLPAR	;IF =0,NO MORE PARAMS.
	CAME A,RPARV	;NO PARENTHESES OR COMMAS HERE, PLEASE.
	CAMN A,COMMAV
	ERROR (MISSING PARAMETER)
	CAIN T,FAOPAR	;MUST THIS PARAM. BE AN ARRAY NAME ?
	JRST FAPAR	;YES.
	PUSHJ P,EXPR	;NO, LET IT BE AN EXPRESSION.
FUNC2:	CAMN A,COMMAV	;IS IT A COMMA ?
FUNC3:	PUSHJ P,SCAN	;YES, ALTHOUGH WE DONT REALLY CARE.
	JRST FUNC4

FLPAR:	CAME A,RPARV	;LAST PARAM. IS FOLLOWED BY ).
	ERROR (MISSING RIGHT PAREN.)	; ... OR ELSE.
FNOPR:	PUSHJ P,GFUNC	;CALL GENERATORS.
	ILDB A,-1(P)	;GET NO. OF AC CONTAINING RESULT.
	SUB P,[XWD 4,4]	;FORGET ABOUT THINGS IN STACK.
	POPJ P,

FAPAR:		;PARAMETER IS NAME OF FUNCTION ARRAY.
	PUSHJ P,GAPAR	;CALL GENERATOR.
	PUSHJ P,SCAN
	JRST FUNC2

FDPAR:	PUSHJ P,GDPAR	;GENERATE A DUMMY PARAM.
	JRST FUNC1
FDPAR2:	PUSH OSP,[0]	;EMIT A DUMMY PARAM., BUT WITHOUT
	JRST FUNC1	;ANY INSTR. TO ZERO IT AT I-TIME.

;  HERE ARE THE GLORIOUS, SUPER-INTELLIGENT, SCHIZOPHRENIC
;  CODE GENERATORS.  LOOK UPON THEM AND BE AMAZED.

MULGEN:	SKIPA T,[FMP]	;GENERATE A MULTIPLY.
ADDGEN:	MOVSI T,(<FAD>)	;SEE THE STUPID FAIL !
	PUSH P,T
	PUSHJ P,GGET1	;GET ONE OPERAND IN AN AC.
GEN1:	POP P,C	;RECOVER THE OPCODE.
GEN2:	PUSHJ P,EMINST	;EMIT THE INSTRUCTION.
	JRST MRKAC	;MARK THE AC FULL AND RETURN.

DIVGEN:	SKIPA T,[FDV]	;GENERATE A DIVIDE ...
SUBGEN:	MOVSI T,(<FSB>)	; .. OR A SUBTRACT.
	PUSH P,T
	PUSHJ P,GGET2	;GET FIRST OPERAND IN AN AC.
	JRST GEN1

UMGEN:	PUSHJ P,GMURKA	;UNARY MINUS.  GET THE OPERAND.
	PUSH P,E
	PUSHJ P,GETAC	;GET A FREE AC.
	POP P,B	;BRING BACK AC ADDRESS.
	MOVSI C,(<MOVN>)	;EMIT GOOD INSTRUCTION.
	JRST GEN2

MULOP←←MULGEN
ADDOP←←ADDGEN
SUBOP←←SUBGEN
DIVOP←←DIVGEN

ASNGEN:		;COMPILE STORE FOR ASIGNMENT STMT.
ASNOP:	PUSH P,-1(OSP)	;SAVE PTR. TO GOOD BITS OF VRBL.
	PUSHJ P,GMURK	;GET EXPR. AND LEFT-PART VARIABLE.
	EXCH D,E	;GET THEM IN RIGHT ORDER.
	PUSHJ P,GG2	;GET EXPR. IN AN AC.
	POP P,T	;RECOVER PTR. TO VRBL. GOOD BITS WORD...
	MOVE H
	LSH =35-PRVBT	;PUT R-TIME FLAG IN RIGHT POSITION...
	TLNN B,GPBIT	;IF NOT A P-SYMBOL,
	ORM (T)	;SET R-TIME BIT CORRECTLY.
	MOVSI C,(<MOVEM>)	;EMIT A MOVEM TO STORE VALUE OF EXPR.
	JRST EMINST


;  HA! I BET YOU THOUGHT WE WERE DONE, DIDN'T YOU ?

	; WELL, HERE BEGINS AN INFINITE REGRESSION OF
	; CLEVER ,GRUBBY ROUTINES WHICH DO THE
	; DIRTY WORK FOR THE GENERATORS.

; GPONDER REMOVES THE TOP THING FROM THE OPERAND STACK,
; LOVINGLY PATS ITS MAGIC BITS INTO STANDARD FORMAT,
; AND SETS A FLAG INDICATING WHETHER IT IS AN
; R-TIME VARIABLE OR NOT.

GPONDER: MOVEI H,0	;RESET R-TIME VARIABLE FLAG.
GPOND1:	POP OSP,T	;GET TOP THING.
	TLNE T,FOOBIT	;IS IT A FOO-SYMBOL?
	JRST GPFOO	;YES.
	TLNE T,NUMFLG	;A NUMBER ?
	POPJ P,		;YES. WE ARE DONE.
	TLNE T,SRACBT+RVBT	;AN R-TIME AC OR VARIABLE ?
	MOVEI H,1	;YES. SET R-TIME FLAG.
	TLNE T,SRACBT	;AN R-TIME AC ?
	SETZM RACS(T)	;YES. MARK IT FREE.
	TLNE T,SIACBT	;(SAME FOR I-TIME AC).
	SETZM IACS(T)
	TLNE T,VRBLBT	;A VARIABLE ?
	HRR T,(T)	;YES. GET RT. HALF GOOD BITS.
	POPJ P,
GPFOO:	TRZE T,400000	;IS IT A P-SYMBOL?
	JRST GPONP	;YES.
GPONU:	MOVEI H,1	;REFERS TO A UINIT GENERATOR; SET FLG.
	HRRZS T		;GET NO. OF UNIT GEN.
	CAMLE T,UOPTR	;NO FORWARD REFERENCES TO UNIT GEN.
	ERROR (FORWARD REF. TO UNIT GENERATOR)
	MOVE T,UOTBL(T)	;GET ADDRESS OF ITS OUTPUT CELL.
	POPJ P,

GPONP:
	ADDI T,PBASE	;BASE OF PARAM. ARRAY.
	HRLI T,GPBIT	;MARK AS P-SYMBOL.
	POPJ P,


; GMURK CLEVERLY GPONDERS THE TOP TWO OPERANDS,
; AND IF ONE OF THEM IS AN R-TIME VARIABLE
; AND THE OTHER IS AN I-TIME AC OR A P-SYMBOL, IT STORES
; THE LATTER WHERE IT WILL BE SAFE UNTIL R-TIME.

GMURKA:	MOVEI H,0
GMURK1:	TDZA T,T	;PROCESS ONLY TOP STACK ELEMENT.
GMURK:	PUSHJ P,GPONDER	;GPONDER THE FIRST OPERAND.
	PUSH P,T	;SAVE IT
	PUSHJ P,GPOND1	;NOW THE SECOND.
	POP P,D	;PUT THEM BOTH IN SOME SAFE ACCUMULATORS.
	MOVE E,T
	SKIPN H	;IS EITHER ONE AN R-TIME VARIABLE ?
	POPJ P,	;NO.
	TLNE E,SIACBT+GPBIT	;AN I-TIME AC OR A P-SYMBOL ?
	JRST GM2	;YES.
	TLNN D,SIACBT+GPBIT	;HOW ABOUT THIS ONE ?
	POPJ P,		;HE ISN'T, EITHER. RETURN.
	SKIPA F,[EXP D]	;BAGBITING MACROX.
GM2:	MOVEI F,E	;SEE THE TWO HEADED MONSTER.
	MOVE A,(F)	;GET THE RELEVANT THING.
	TLNE A,GPBIT	;A P-SYMBOL, OR AN I-TIME AC ?
	JRST GM3	; A P-SYMBOL.
	MOVE B,VLOC	;STORE IT IN VARIABLE AREA.
GM3B:	MOVEM B,(F)	;CHANGE THE OPERAND INDICATOR.
	MOVE C,[MOVEM EMICDI]	;EMIT THE STORE INSTRUCTION.
	PUSHJ P,EMINST
	JRST EMDV	;MAKE APLACE IN THE VARIABLES FOR IT.

GM3:	SKIPN T1,(A)	;HAS THE PARAMETER ALREADY BEEN
	JRST GM3A	; PUT IN VAR. AREA ?
	MOVEM T1,(F)	;YES. CHANGE POINTER.
	POPJ P,

GM3A:	PUSHJ P,GETIAC	;FIND FREE I-TIME AC.
	MOVE B,(F)
	MOVE T,VLOC	;GET VAR. LOC. CTR.
	TLO T,GPBIT
	MOVEM T,(B)	;ENTER IN PARAMTER TABLE.
	MOVE C,[MOVE EMICDI]	;EMIT INSTR. TO
	PUSHJ P,EMINST	;PICK UP THE PARAMETER.
	MOVE B,VLOC	;GET LOC. AGAIN...
	TLO B,GPBIT	;MARK AS A P-SYMBOL.
	JRST GM3B	;NOW STORE THE PARAMETER IN VAR. AREA.


; STILL MORE KLUGES. PAUSE TO GET YOUR BREATH NOW.

;GGET1 ARRANGES TO HAVE ONE OF THE TOP TWO OPERANDS
; IN AN AC.  IT RETURNS IN 'A' THE ADDRESS OF THAT AC, AND
; IN 'B' THE ADDRESS OF THE OTHER OPERAND, WITH RELOCATION
; BITS IN LEFT HALF.

GGET1:	PUSHJ P,GMURK	;PROCESS TOP TWO OPERANDS.
	TLNN D,SIACBT+SRACBT	;IS FIRST ONE IN AN AC ?
	JRST GG2	;NO.
	MOVE A,D	;YES. WE ARE DONE.
	MOVE B,E
	POPJ P,
GGET2:	PUSHJ P,GMURK	;GGET2 GETS SECOND OPERAND IN AN AC.
GG2:	MOVE A,E	;PUT OPERAND IN A.
	TLNE A,SIACBT+SRACBT	;IS IT ALREADY IN AN AC ?
	JRST GL2A	;YES. WIN BIG.
	TLNE D,SIACBT+SRACBT	;HOW ABOUT OTHER OP. ?
	SETOM @ACTB3(H)	;AN AC... MARK IT FULL TEMPORARILY.
	PUSHJ P,GETAC	;GET A FREE AC OF THE APPROPRIATE KIND.
	MOVE B,E	;LOAD SECOND OPERAND INTO IT.
	MOVSI C,(<MOVE>)	;EMIT LOAD INSTR.
	PUSHJ P,EMINST
	TLNE D,SIACBT+SRACBT	;IF OTHER OP. IS IN AN AC,
	SETZM @ACTB3(H)		;MARK IT FREE NOW.
GL2A:	MOVE B,D	;PUT  OTHER OP IN B.
	POPJ P,

; EMINST IS THE INSTRUCTION EMITTING ROUTINE.  CALL IT
; WITH AC IN A,THE ADDRESS (+ RELOC. BITS) IN B, AND
; OPCODE IN C. IF RIGHT HALF OF C IS NON-ZERO, IT IS THE
; ADDRESS OF THE APPROPRIATE BUFFER EMITTING ROUTINE; 
; OTHERWISE THE INSTR. IS PLACED IN THE I-TIME
; OR R-TIME BUFFERS ACCORDING TO THE STATE OF THE FLAG IN H.

EMINST:	PUSH P,A	;SAVE IT.
	HLL A,C	;ASSEMBLE INSTRUCTION IN A.
	DPB A,[POINT 4,A,12]	;PUT IN AC FIELD.
	HRR A,B		;ALSO ADDRESS.
	TLZE B,FPARBT	;IS ADDR. A FORMAL PARAMETER ?
	TLO A,20+RA	;YES. ADD INDIRECT BIT AND INDEX.
	HLRZS B	;PUT RELOC. BITS FOR ADDRESS IN RIGHT HALF OF B.
	PUSH P,[EXP EMIN2]	;RETURN ADDRESS.
	TRNE C,-1	;RH OF C =0 ?
	JRST (C)	;NO.
	JRST @EMITB(H)
POPAJ:		;A USEFUL ENTRY POINT.
EMIN2:	POP P,A
	POPJ P,
EMITB:	EMICDI
	EMCDI
ACTB3:	XWD D,IACS
	XWD D,RACS

;GETAC SEARCHES FOR A FREE AC, EITHER I-TIME OR 
; R-TIME, AS INDICATED BY THE STATE OF THE FLAG IN H.

GETAC:	SKIPE H	;ARE WE EMITTING R-TIME CODE ?
GETRAC:	SKIPA T3,[XWD SRACBT+A,RACS]	;YES, FIND A R-TIME AC.
GETIAC:	MOVE T3,[XWD SIACBT+A,IACS]	;FIND AN I-TIME AC.
	MOVE A,[XWD -NACS,NFACS]	;CONSIDER ONLY AC'S 4-14
	TRNE FL,CSBRBT	; ..UNLESS WE'RE COMPILING A FUNCTION..
	MOVE A,[XWD -NFACS,0]	;WE ARE. CONSIDER ONLY 0-3.
	SKIPE @T3	;INDIRECT ADDRESSING IS GOOD FOR YOU.
	AOBJN A,.-1	;NOT FREE. TRY FOR NEXT ONE.
	JUMPLE A,GETAC3	;DID WE FIND ONE ?
	PUSHJ P,GETAC2	;NO. STORE ONE.
GETAC3:	HRLI A,SRACBT	;YES. PUT IN APPROPRIATE FLAG BITS.
	TLNN T3,SRACBT	;OOPS, IT'S AN I-TIME AC.
	HRLI A, SIACBT
	POPJ P,

GETAC2:	SUBI A,1	;STORE HIGHEST AC.

GSVAC:	MOVE T,@T3	;FIND OUT WHO'S IN HIM.
	MOVE B,VLOC	;GET LOC. TO STORE HIM IN.
	MOVEM B,(T)	;FIX UP HIS STACK ENTRY.
	SETZM @T3	;MARK HIM EMPTY.
	MOVSI C,(<MOVEM>)	;EMIT THE STORE INST.
	PUSHJ P,EMINST
	JRST EMDV	;LEAVE A  PLACE IN VARIABLES AREA.

;MRKAC PUTS THE AC SYMBOL IN A BACK ON THE STACK AND MARKS
; THE CORRESPONDING AC AS FULL.

MRKAC0:	IOR A,MRKTAB(H)	;MARK IAC 1 OR RAC 1 FULL.

MRKAC:	PUSH OSP,A	;PUT IT ON STACK.
	TLNN A,SRACBT	;AN R-TIME AC?
	HRRZM OSP,IACS(A)	;NO, MARK CORRESPONDING I-TIME AC FULL.
	TLNE A,SRACBT
	HRRZM OSP, RACS(A)
CPOPJ:	POPJ P,

MRKTAB:	XWD SIACBT,0	;DESCRIPTOR FOR I-TIME AC NO. 1
	XWD SRACBT,0	;R-TIME AC 1.


;; MORE GENERATORS.

GAPAR:	;; HANDLE A PARAMETER WHICH IS AN ARRAY NAME.
	TLNE A,SWVBT	;IS IT AN ARRAY IDENTIFIER OR
	HRR A,(A)
	TLNE A,FPARBT+SWVBT	; A FORMAL PARAMETER ?
	JRST GAPR1	;YES.
	TLNE A,FOOBIT	;BETTER BE A FOO-SYMBOL, THEN....
	TRZN A,400000	;FURTHERMORE, IT MUST BE A P-SYM.
	ERROR(IMPROPER ARRAY PARAMETER)
	PUSH P,A	;SAVE P NO.
	PUSHJ P,GETIAC	;FIND FREE I-TIME AC.
	POP P,B
	ADDI B,PBASE	;CALC. ADDR. OF P-SYMBOL.
	MOVE C,[MOVE EMICDI]	;EMIT MOVE AC,P-SYMBOL TO THE
	PUSHJ P,EMINST	;I-TIME CODE STREAM.
	HRLI A,(<MOVEM>)	;NOW A MOVEM AC,  INTO THE PARAMETER
	DPB A,[POINT 4,A,12]	;LOCATION.
	TRZA A,-1	;CLEAR ADDRESS FIELD.
GDPAR:	MOVSI A,(<SETZM>)	;PARAM. LIST AT I-TIME.
	PUSH OSP,ILOC	;PUT ARRAY MARKER IN OPERAND
	MOVSI T,SWVBT+FPARBT	;STACK SO A FIXUP CAN BE EMITTED TO
	IORM T,(OSP)	;THE UPCOMMING HRRM WHEN THE PARAMETERS
	MOVEI B,0	;NO RELOCATION, PLEASE.
	JRST EMICDI	;EMIT HRRM TO STORE ARRAY LOC. INTO
		;PARAMETER CELL, AND RETURN.
GAPR1:	PUSH OSP,A	;PLACE IN OPERAND STACK.
	POPJ P,

GFUNC:	  ;; GENERATE A FUNCTION CALL.
	MOVE A,@-3(P)	;PICK UP THE CALLING  INSTR. FOR THE FUNCTION.
	MOVE D,RLOC	;DECIDE WHETHER CALL IS TO BE IN
	MOVEI H,0	;R-TIME OR I-TIME CODE.
	TLZN A,20	;IND. BIT IN INSTR. SAYS R-TIME ALWAYS.
	CAME D,-4(P)	;ALSO R-TIME IF ANY R-TIME PARAMETERS
	MOVEI H,1	;HAVE BEEN COMPILED.
GFUNC8:	MOVE T3,ACTB1(H)
	MOVSI A,-NFACS	;PREPARE TO SEARCH AC'S 0-4.
	SKIPN T,@T3	;IS THIS ONE IN USE ?
	AOBJN A,.-1	;NO.
	JUMPG A,GFUNC6	;DID WE FIND A BUSY ONE ?
	PUSHJ P,GSVAC	;YES. SAVE IT.
	JRST GFUNC8
GFUNC6:	PUSH P,-1(P)	;PUT PAR. COUNT ON STACK.
	HRRZM P,TEMP1#	;SAVE LOC. OF COUNT.
GFUNC5:	SOSGE @TEMP1	;MORE PARAMS ?
	JRST GFUNC4	;NO.
	PUSHJ P,GMURK1	;GET A PARAM.
	TLNN E,SWVBT	
	TLNN E,FPARBT	;IS IT A FORMAL PARAMETER ?
	JRST GFUNC7	;NO, THANK GOD.
	MOVE A,E	;SIGH. THE PRICE OF HONESTY ...
	HRLI A,(<MOVE (RA)>)	;EMIT CODE TO PICK UP THE
	MOVEI B,0	;PARAM. PTR. AND PUT IT IN THE
	PUSHJ P,@EMITB(H)	;CURRENT CALLING SEQUENCE.
	MOVE E,ILOC(H)	;SAVE ILOC OR RLOC FOR LATER FIXUP.
	TLO E,FPARBT	;MIGHT AS WELL USE THIS BIT...
	MOVSI A,(<MOVEM>)	;NOW THE SECOND INSTR....
	PUSHJ P,@EMITB(H)
GFUNC7:	PUSH P,E	;SAVE IT.
	JRST GFUNC5	;GET ANOTHER.
GFUNC4:	POP OSP,A	;NOW EMIT THE CALLING INSTR.
GFUNC2:	LDB B,[POINT 4,A,17]	;RELOC. BITS.
	TLZ A,37
	TLZE A,SWVBT	;IS IT AN ARRAY NAME ?
	TLO A,INSXR		;YES. ADD INDEX FIELD.
GFUNC3:	PUSHJ P,@EMITB(H)	;
	POP P,A	 	;GET PARAM. FROM STACK.
	JUMPL A,CPOPJ	;IF IT'S THE MARK, RETURN.
	TLZN A,FPARBT	;IS IT A FORMAL PARAMETER ?
	JRST GFUNC2	;NO. EMIT IT.
	MOVEI B,.FXBTS	;YES. EMIT A FIXUP TO THE RIGHT INSTRUCTION.
	TLZ A,400000+LRFXBT+SWAPBT	;A REPLACEMENT FIXUP TO RT. HALF.
	TLO A,RRFXBT
	PUSHJ P,@EMITB2(H)	;EMIT IT TO I-TIME OR R-TIME BUFER.
	MOVEI B,0	;NOW RESERVE SPACE FOR THE PARAM.
	JRST GFUNC3
EMITB2:	EMICD
	EMCD
ACTB1:	XWD SIACBT+A,IACS	;PTR. TO IACS,INDEXED BY B.
	XWD SRACBT+A,RACS

;;   UTILITY RUOTINE TO ENTER AN ITEM IN THE MAIN SYMBOL TAB.

GETNAM:	PUSHJ P,SCANV	;SCAN AN IDENTIFIER.
GETNM1:	AOS T,(P)	;TO SKIP PARAM ON RETURN.
	JUMPE A,GNM2	;SHOULD BE UNDEFINED...
	TLOE A,DF	;IT'S NOT. MAYBE IT'S A DELIMITER ?
	ERROR (MISSING IDENTIFIER)
	TLNN A,@-1(T)	;NO. MAYBE ALREADY RIGHT TYPE ?
	ERROR (MULTIPLY DEFINED SYMBOL)
	SKIPGE -1(T)	;AH, IT IS. SHOULD WE REENTER IT ?
	POPJ P,		;NO. ITS OLD ENTRY WILL DO.
GNM2:	HRLZ A,-1(T)	;YES. GET TYPE BITS.

AENTER:	HRRZ JOBFF	;GET NEXT FREE LOCATION.
	HRRZ B,CBNO	;GET BUCKET NO. OF THING JUST SCANNED.
	EXCH BUCTBL(B)	;UPDATE BUCKET HEAD.
	AOS B,JOBFF
	MOVEM -1(B)	;PUT THE LINK IN THE NEW ENTRY.
	MOVEM A,1(B)	;PUT THE RANDOM GOOD BITS IN.
	MOVE ACCUM	;GET FIRST WORD OF NAME.
	MOVEM (B)	;PUT IN TABLE.
	AOS B,JOBFF
	MOVEI T,ACCUM+1	;PREPARE TO MOVE REST OF NAME.
AEL1:	AOS JOBFF	
	SKIPN T1,(T)	;ANY MORE OF THE NAME ?
	JRST AEL2	;NO.
	MOVEM T1,@JOBFF	;YES. PUT IN TABLE.
	CAIL T,ACCUM+2	;UNLESS FIRST OR SECOND WORD,
	SETZM (T)	;ZERO WORD IN ACCUM.
	AOJA T,AEL1
AEL2:	HRRZ JOBSYM	;GET BOTTOM OF BUFFER AREA.
	CAMG JOBFF	;HAVE WE OVERRUN IT ?
	ERROR(CORE IS FULL)
	HRR A,B
	HRRZ JOBFF
	HRLM JOBSA
	POPJ P,


;;  INITIALIZATION OF THE COMPILER.

EXTERNAL JOBFF,JOBSA
JOBSYM:	0

SCOMPA:	MOVE OSP,[XWD -LOSTK,OSTK-1]	;INIT. OPERAND STACK.
	PUSH OSP,JOBSYM	;...SO WE CAN RESTORE IT LATER.
	MOVSI IRELBT	;INIT THE THREE LOCATION
	MOVEM ILOC	;COUNTERS (APPROPRIATE RELOCATION
	MOVSI RRELBT	;BITS LIVE IN LEFT HALF OF EACH).
	MOVEM RLOC
	MOVSI VRELBT
	MOVEM VLOC
	MOVEI T1,2	;SET UP THE THREE CHAINS OF OUTPUT
SCMP1:	SETZM OBPTR(T1)
	PUSHJ P,GBUF	;BUFFERS.
	HRRZM T,FCBUF(T1)	;PTR. TO FIRST BUFFER OF CHAIN
	SOJGE T1,SCMP1	;DO FOR ALL THREE CHAINS.
	SETZM IARR1	;ZERO SOME TABLES AND STUFF.
	MOVE [XWD IARR1,IARR1+1]
	BLT IARR2-1
	MOVEI FL,0	;CLEAR FLAGS.
	POPJ P,

SCOMP:	PUSHJ P,SCOMPA	;INIT. THE COMPILER.
	MOVE [XWD IARR2-1,IARR2]
	BLT IARR3-1	;ZERO REST OF TABLES.
	POPJ P,

;;  SYNTAX ANALYZER.

SSTATL:	PUSHJ P,SMCSCN	;SCAN NEXT NON-SEMICOLON.
STATL:	CAMN A,FINV	;IS IT A FINISH ?
	JRST ENDP1	;YES.
	PUSHJ P,STAT	;NO. SCAN A STATEMENT.
	JRST SSTATL	;GO BACK FOR MORE.

SSTAT:	PUSHJ P,SMCSCN
STAT:	MOVEI H,0	;CLEAR 'R-TIME CODE' FLAG.
	JUMPGE A,STAT2	;A DELIMITER ?
	TLNE A,DECLBIT	;YES. A DECLARATION ?
	JRST (A)	;YES. DISPATCH TO RIGHT ROUTINE.
STAT2:	PUSHJ P,STMT1	;IT HAS TO BE A STMT1.
STATL1:	CAME A,SEMICV	;SEMICOLON AFTER EVERY STMT.,PLEASE.
	ERROR (MISSING SEMICOLON)	;I HATE MYSELF FOR THIS.
	TDZ FL,[XWD ERRFLG,EXTFLG]	;TURN OFF ERROR FLAG.
	POPJ P,		;END OF STATEMENT.
	
EXTD:	PUSHJ P,SCAN	;"EXTERNAL" DECLARATION.
	CAME A,FUNV	;BETTER BE "FUNCTION".
	ERROR (<EXTERNAL FUNCTIONS ONLY,PLEASE.>)
	TRO FL,EXTFLG	;SET FLAG.
	JRST DFUNC

SSTMT1:	PUSHJ P,SCAN	
STMT1:	SKIPN A	;IS IT UNDEFINED ?
	ERROR (UNDEFINED IDENTIFIER)
STMT1A:	TLNE A,FUNBIT	;<STMT1>=<FUNCTION CALL> ! <ASN. STMT>
	JRST SFUNC	;A FUNCTION CALL.
	TLNN A,VRBLBT!FOOBIT	;BETTER BE A SIMPLE VARIABLE.
	ERROR (SIMPLE VARIABLE REQUIRED HERE.)
	PUSH OSP,A	;STACK IT.
	PUSHJ P,SCAN	;GET LEFT ARROW.
	CAME A,LARV
	ERROR (ILLEGAL STATEMENT)
	PUSHJ P,ASTMT1	;IT'S AN ASSIGNMENT STMT. COMPILE IT.
	JRST POPAJ	;RESTORE A(WHICH WAS SAVED BY ASTMT)
			; AND RETURN.
SFUNC:	PUSHJ P,FUNCAL	;COMPILE FUNCTION CALL
	JRST SCAN	;RETURN.

SMSC1:
SMCSCN:	PUSHJ P,SCAN	;SCAN PAST NEXT SEMICOLON.
SMCS1:	CAMN A,SEMICV
	JRST SMCSCN
	POPJ P,


ENDSTL:	RELEAS DT,	;ALL DONE. RELEAS INPUT DEVICE.
ENDP1:
	MOVEI A,0
	MOVEI B,.FXBTS	;PUT END MARKS IN THE BUFFERS.
	PUSHJ P,EMCD
	PUSHJ P,EMICD
	PUSHJ P,EMVCD
	POP OSP,JOBSYM	;RESTORE JOBSYM.
	POPJ P,
EXTERNAL JOBDDT,JOBREL

DVRBL1:	CAME A,COMMAV	;IS IT A COMMA ?
	JRST STATL1	;NO. END OF DECL.
DVRBL:	PUSHJ P,SCAN	;GET NEXT ITEM.
	CAMN A,CTBL+"/"	;IS IT A "/" ?
	JRST DVRBL2	;YES. DEFINE FOLLOWING VARIABLE AS R-TIME.
	PUSHJ P,GETNM1	;NO. MUST BE NAME OF VARIABLE. PUT IN SYM. TABLE.
	XWD 400000,VRBLBT	;PARAM. TO GETNM1.
DVRBL4:	JUMPL A,DVRBL3	;WAS IT ALREADY DEFINED ?
	AOS A,JOBFF	;NO, IT'S NEW. LEAVE WORD FOR THE VALUE.
	SUBI A,1	;GET PTR. TO THAT WORD.
	HRRM A,(B)	;PUT IN GOOD BITS WORD (NO REL. BITS).
DVRBL3:	PUSHJ P,SCAN	;GET COMMA OR SEMICOLON.
	JRST DVRBL1	;BACK FOR MORE.

DVRBL2:	PUSHJ P,GETNAM	;SCAN AND ENTER NAME OF VARIABLE.
	XWD 400000,VRBLBT!RVBT	;INCLUDE 'R-TIME' BIT.
	JRST DVRBL4

DF5:	CAME A,COMMAV	;ARE THERE MORE DEFINITIONS ?
	JRST STATL1	;NO.
DFUNC:	TRO FL,CSBRBT+SFOOBT	;ENTER FUNCTION DEFINING MODE.
	PUSHJ P,GETNAM	;GET FUNCTION NAME.
	EXP FUNBIT	;PARAMETER TO GETNAM.
	PUSH P,BUCTBL	;####$$%%$ A TEMPORARY KLUGE !!
	MOVE A,JOBFF	;GET FIRST FREE STORAGE LOC.
	HRRM A,(B)	;MAKE GOOD BITS WORD POINT THERE.
	HRLI A,600	;MAKE A INTO A BYTE POINTER.
	PUSH P,A
	PUSH P,A
	IBP (P)	;THIS POINTER IS FOR PARAMETER DESCRIPTORS.
	HRLI A,400000+LRFXBT+RRFXBT	;NOW EMIT FIXUP TO THE 
				;LOCATION IN THE SYM. TABLE WHICH WILL
	MOVEI B,.FXBTS	;CONTAIN THE CALLING INSTR. FOR THE
			; FUNCTION, SO IT CAN BE UPDATED AT
	PUSHJ P,EMICD	;LOAD TIME WITH THE RELOCATED ADDRESS OF THE FUNCTION.
	ADDI A,5	;LEAVE ENOUGH ROOM FOR 22 PARAMETER
	HRRZM A,JOBFF	;DESCRIPTORS.
	TRNN FL,EXTFLG	;IS IT AN EXTERNAL FUNCTION ?
	SKIPA A,ILOC	;NO. ADDRESS IS IN ILOC.
	PUSHJ P,SYMSCH	;YES. FIND STARTING ADDRESS.
	TLO A,(<JSA RA,>)	;MAKE INTO A CALLING INSTR.
	MOVEM A,@-1(P)	;PLACE IN SYM. TABLE.
	LDB B,[POINT 4,A,17]	;GET THE RELOCATION BITS.
	TLZ A,17	;TURN THEM OFF IN THE INSTRUCTION WORD.
	PUSHJ P,EMICD	;EMIT AS VALUE OF ABOVE FIXUP.
	PUSH P,[-1]	;INIT. THE PARAMETER COUNT.
	PUSHJ P,SCAN	;LOOK AT NEXT THING.
	CAME A,LPARV	;A ( ?
	JRST DFNOPR	;NO. THERE ARE NO PARAMETERS.
DF2:	PUSHJ P,SCAN	;SCAN A PARAMETER.
	CAME A,ARRV	;IS IT AN ARRAY NAME ?
	JRST DF2A	;NO.
	TRO FL,ARRFLG	;YUP. SET FLAG AND GET NAME OF
	JRST DF2	;PARAM.

DF2A:	TLNE A,DF+NUMFLG
	ERROR (ILLEGAL FORMAL PARAMETER)
	AOS A,(P)	;INCREMENT PARAMETER COUNT.
	HRLI A,FPARBT!VRBLBT	;MAKE A INTO FORMAL PARAM. INDICATOR
	PUSHJ P,AENTER	; AND ENTER THE SYMBOL.
	MOVEI 2	;PUT 'ORDINARY' FLAG IN THE PARAMETER 
	TRZE FL,ARRFLG	;AN ARRAY NAME PARAM. ?
	MOVEI 1	;YES. USE RIGHT DESCRIPTOR BIT.
	IDPB -1(P)	;DESCRIPTOR FOR THIS PARAM.
	PUSHJ P,SCAN
	CAMN A,COMMAV	;A COMMA ?
	JRST DF2	;YES LOOK FOR MORE PARAMETERS.
	CAME A,RPARV	;IT BETTER BE A ).
	ERROR (MISSING RIGHT PAREN.)
	PUSHJ P,SCAN	;GET THE =.
	MOVEI B,0	;FLAG END OF PARAMETER DESCRIPTORS.
	IDPB B,-1(P)
DFNOPR:	TRNE FL,EXTFLG	;IS THIS AN EXTERNAL FUNCTION ?
	JRST DF4	;YES. LOOK FOR NO DEFINITION.
	CAME A,CTBL+"="
	ERROR (MISSING = IN FUNCTION DEFINITION)
	PUSHJ P,EMICDI	;LEAVE ROOM FOR THE JSA WORD.
	TRZ FL,SFOOBT	;LET SCANNER SEE FOO-SYMBOLS AGAIN.
	PUSHJ P,SEXPR	;SCAN AN EXPRESSION.
DF4:	PUSH P,A
	TRNE FL,EXTFLG	;AN EXTERNAL ?
	SKIPA E,[XWD SIACBT,0]	;YES. RESULT ALWAYS IN 0.
	PUSHJ P,GMURK1	;GET IT OFF STACK.
	PUSHJ P,GG2	;MAKE SURE ITS IN AN AC.
	IDPB A,-2(P)	;TELL UNIVERSE WHICH AC .
	AOS B,-1(P)	;ADJUST PARAMETER COUNT.
	IDPB B,-3(P)	;PUT IN SYM. TABLE.
	MOVEI A,RA	;EMIT RETURN INSTR.
	MOVSI C,(<JRA RA,(RA)>)
	TRNN FL,EXTFLG	;...UNLESS THIS IS AN EXTERNAL.
	PUSHJ P,EMINST
	AOS A,-2(P)	;FIND TOP OF PARAM. DESC. STRING.
	HRRZM A,JOBFF	;RESET FREE STORAGE.
	HRLM A,JOBSA
	POP P,A
	SUB P,[XWD 3,3]	;FORGET JUNK IN STACK.
	POP P,BUCTBL	;##$$%$# MORE OF THAT KLUGE !!!
	TRZ FL,CSBRBT+SFOOBT	;LEAVE FUNCTION DEFINING MODE.
	JRST DF5	;ALL DONE.

;; MORE SYNTAX ANALYZER.  COMPILE AN INSTRUMENT DEFINITION.

CINS:	PUSHJ P,GETNAM	;GET NAME OF INSTRUMENT.
	EXP INSBIT	;PARAMETER TO GETNAM.
	AOS A,JOBFF	;GET PLACE FOR MORE GOOD BITS..
	SUBI A,1
	HRRM A,(B)	;MAKE RANDOM BITS WORD POINT THERE.
	HRLI A,RRFXBT	;RIGHT HALF REPLACEMENT TYPE FIXUP.
	MOVEI B,.FXBTS	;EMIT FIXUP TO RIGHT HALF FROM
	PUSHJ P,EMICD	;FIRST LOC. OF I-TIME CODE.
	HRLI A,LRFXBT+SWAPBT	;FIXUP TO LEFT HALF FROM FIRST LOC.
	PUSHJ P,EMCD	;OF R-TIME CODE.
CINS5:	PUSHJ P,SCAN
CINS3:	PUSHJ P,SMCS1	;IGNORE SEMICOLON, IF ANY.
	CAMN A,ENDV	;IS IT AN END ?
	JRST CINSE	;YES.
	TLNN A,UGBIT	;IS IT A UNIT GENERATOR CALL ?
	JRST CINS4	;NOT A UNIT GENERATOR.
	HRRZM A,CINST1#	;SAVE IT.
	PUSHJ P,SCAN	;PEEK AT NEXT THING.
	CAMN A,CTBL+"["	;IS IT A [ ?
	JRST CUG1	;YES. UNIT GEN. HAS CONTROLLED CALLING RATE.
	MOVEM A,SNCHR	;NO, IT'S PROBABLY THE (. PUT IT BACK WHERE SCAN WILL SEE IT AGAIN.
	PUSHJ P,CINS6	;NOW COMPILE THE CALL ON THE UNIT GEN.
	JRST CINS5	;BACK FOR MORE.

CINS6:	MOVE A,CINST1	;RECOVER POINTER FOR USE OF FUNCAL.
	PUSHJ P,FUNCAL	;COMPILE CALL ON THE UNIT GEN.
	MOVE B,VLOC	;GET LOC. FOR OUTPUT OF UNIT GEN.
	AOS C,UOPTR	;INCREMENT COUNT OF UNIT GENS.
	MOVEM B,UOTBL(C)	;ENTER OUTPUT LOC. IN TABLE.
	MOVE C,[MOVEM EMCDI]	;EMIT STORE INSTRUCTION TO
	PUSHJ P,EMINST	;PUT OUTPUT OF UNIT GEN. AWAY.
	PUSHJ P,EMDV	;MAKE ROOM IN VARIABLES AREA FOR IT.
	MOVE T,@CINST1	;RETRIEVE PTR. TO RANDOM GOOD BITS.
	SKIPN A,-1(T)	;DOES UNIT GEN. HAVE I-TIME CODE?
	POPJ P,		;NO.
	PUSHJ P,EMIABS	;YUP. EMIT THE CALLING INSTR.
	HRRZ A,RLOC	;AS PARAMETER, GIVE IT A PTR. TO
	MOVEI B,RRELBT	;JUST AFTER THE MOVEM EMITTED
	PUSHJ P,EMICDI		;ABOVE.
	POPJ P,

CINS4:	PUSHJ P,STMT1	;ITS NOT A UNIT GEN. CALL.
	JRST CINS3	;NO
CINSE:	SETZM IARR1	;YES. ZERO THINGS.
	MOVE [XWD IARR1,IARR1+1]
	BLT IARR3-1
	MOVE A,[POPJ P,]	;PUT RETURN INSTR. AT END OF
	MOVEI B,0	;THE I-TIME CODE.
	PUSHJ P,EMICDI
	PUSHJ P,EMCDI	;ALSO THE R-TIME CODE.
CINSR1:	PUSHJ P,SCAN
	JRST STATL1

;; IF THE NAME OF A UNIT GENERATOR IS FOLLOWED BY AN
;;  EXPRESSION IN SQUARE BRACKETS, THE U.G. GETS CALLED ONLY
;; EVERY N TIME STEPS, WHERE N IS THE VALUE OF THE EXPRESSION.
;; N IS RECALCULATED EVERY TIME THE U.G. IS CALLED.

CUG1:	MOVE C,[AOSGE EMCDI]	;INSTR. TO COUNT NO. OF TIME 
				;STEPS TO SKIP THIS UG.
	MOVE B,VLOC		;GRAB LOCATION IN VARIABLE AREA 
				;TO HOLD COUNT OF TIME STEPS TO SKIP.
	MOVEI A,0	;NO AC FIELD, PLEASE.
	PUSHJ P,EMINST	;EMIT THE AOSGE JUST AHEAD OF THE CODE TO CALL THE U.G.
	MOVE C,[SETZM EMICDI]	;ALSO EMIT AN INSTR. TO THE I-TIME
	MOVE B,VLOC	;CODE TO INIT. THE COUNTER LOCATION TO 0 
			;(SO U.G. GETS CALLED FIRST TIME).
	PUSHJ P,EMINST
	PUSH P,RLOC	;SAVE R-TIME LOC. COUNTER (FOR LATER 
			;FIXUP TO JRST WE ARE ABOUT TO EMIT).
	PUSH P,VLOC	;ALSO VARIABLE LOC., FOR LATER LOADING
			; OF THE STEPS-TO-SKIP COUNTER.
	PUSHJ P,EMDV	;MAKE A WORD FOR IT.
	MOVSI A,(<JRST>)	;NOW EMIT THE JUMP AROUND THE CALL OF
	PUSHJ P,EMCDI	;THE U.G. !!"" N.B.: B IS 0 HERE FROM CALL ON EMDV !!
	PUSHJ P,SEXPR	;NOW COMPILE THE EXPRESSION IN THE BRACKETS.
	CAME A,CTBL+"]"	;SHOULD BE FOLLOWED BY ONE...
	ERROR (MISSING ])
	MOVEI H,1	;INDICATE THAT WE ARE WORKING WITH R-TIME CODE...
	PUSHJ P,GMURK1	;..AND GET EXPR OFF OPERAND STACK.
	PUSHJ P,GG2	;NOW GET IT INTO AN AC.
	MOVSI C,(<FIX>)	;EMIT INSTR. TO FIX VALUE OF EXPRESSION.
	MOVEI B,233000	;MAGIC NO. FOR ADDRESS OF FIX, HO HO.
	PUSHJ P,EMINST
	POP P,B		;GET LOCATION IN VARIABLE AREA OF THE STEPS-TO-SKIP COUNTER.
	MOVSI C,(<MOVNM>)	;AND EMIT INSTR. TO STORE NEGATIVE OF COUNT THERE.
	PUSHJ P,EMINST
	PUSHJ P,CINS6	;NOW COMPILE CALL ON UNIT GENERATOR.
	POP P,A		;RECOVER LOC. OF THE JRST UNDER THE AOSGE.
	MOVEI B,.FXBTS	;EMIT FIXUP TO MAKE IT POINT HERE (I.E., AFTER
	PUSHJ P,EMCD	; END OF U.G. CALL).
	JRST CINS5	;ALL DONE.

;; THE WONDERFUL, WINNING LOADER.

R←←1
I←←2
V←←3

LOADER:	MOVE R,JOBFF	;R-TIME CODE RELOCATION CONST.
	HRRZ I,RLOC	;
	ADD I,R	;I-TIME CONST.
	HRRZ V,ILOC
	ADD V,I	;VARIABLE RELOC. CONST.
	MOVE T3,V
	ADD T3,VLOC	;PROGRAM BREAK.
	HRRZM T3,JOBFF
	HRLM T3,JOBSA	;MAKE SURE IT TAKES.
	HRL A,R	;ZERO THE PROGRAM AREA.
	HRRI A,1(R)
	SETZM (R)
	BLT A,-1(T3)
	MOVEI H,0	;START WITH R-TIME CODE.
LD1:	ADDI H,1	;GO TO NEXT CHAIN OF BUFFERS.
	CAILE H,3	;ALL DONE ?
	POPJ P,	;YES.
	PUSH P,[LDL1]	;FAKE UP A RETURN TO LDL1.
	MOVE C,(H)	;INIT. THE CURRENT LOC. COUNTER.
	SKIPA F,FCBUF-1(H)	;PTR. TO FIRST BUF. OF CHAIN.
LD2:	HRRZ F,(F)	;PTR. TO NEXT BUF. OF CHAIN.
	HRRZ E,F	;SET UP BYTE PTR. TO RELOC. BITS.
	HRLI E,200
	HRRZI D,LOBUFS/12+2(F)	;PTR. TO DATA IN BUF.
	HRLI D,-<LOBUFS-LOBUFS/12-2>	;WORD COUNT.
LDGW:	AOBJP	D,LD2	;WORD COUNT EXHAUSTED ?
	MOVE (D)	;NO. PICK UP NEXT DATA WORD.
	ILDB A,E	;FIRST 2 REL. BITS.
	ILDB B,E	;LAST 2.
	POPJ P,
LDL:	PUSHJ P,LDGW	;GET NEXT WORD FROM BUFFER.
LDL1:	JUMPE A,LDF1	;NO REL. GIVEN; MAY BE A FIXUP.
	JUMPE B,LDRST	;IF NEITHER HALF, THEN IT'S A RESET.
	PUSH P,CLD3	;ANOTHER FAKE RETURN ADDRESS.
LDRL1:	TRNE B,1	;RELOCATE RIGHT HALF ?
	ADD (A)		;YES.
	TRNN B,2	;LEFT HALF ?
	POPJ P,		;NO.
	MOVSS (A)
	ADD (A)
	MOVSS (A)
	POPJ P,
LD3:	ADDM (C)	;PUT IN CORE.
CLDL:	AOJA C,LDL	;GET ANOTHER.

;;  MORE LOADER (BUT NOT MUCH MORE, YOU WILL NOTICE !).

LDF1:
CLD3:	JUMPE B,LD3	;PERHAPS NOT A FIXUP.
	JUMPE LD1	;IT MIGHT EVEN BE AN END MARK.
	LDB T3,[POINT 2,0,15]	;A FIXUP. GET REL. BITS FOR PTR.
	DPB T3,[POINT 5,0,17]
	PUSH P,0
	JUMPG LDF2	;IS VALUE OF FIXUP TO BE FOUND IN BUFFER ?
	PUSHJ P,LDGW	;YES. GET IT.
	PUSHJ P,LDRL1	;PERFORM ANY INDICATED RELOCATION ON IT.
	SKIPA T3,0	;MOVE RELOCATED VALUE INTO T3.
LDF2:	MOVE T3,C	;VALUE IS CURRENT LOCATION.
	POP P,0		;BRING BACK THE POINTER WORD.
	TLNE SWAPBT	;SHOULD WE EXCHANGE HALVES OF THE VALUE ?
	MOVSS T3	;YES.
	TLNE RRFXBT	;SHOULD WE REPLACE THE RIGHT HALF OF THE LOCATION ?
	HRRM T3,@0	;YES. SEE THE POINTER RELOCATION HAPPEN AUTOMATICALLY !!
	TLNE LRFXBT	;REPLACE THE LEFT HALF ?
	HLLM T3,@0	;YES.
	TLNN LRFXBT+RRFXBT	;IF NEITHER HALF REPLACED, THEN
	ADDM T3,@0	;IT'S AN ADDITIVE FIXUP.
	JRST LDL	;BACK TO MAIN LOOP.

LDRST:	HALT	;THE FEATURE YOU HAVE REQUESTED ...



DARR:	PUSH P,[0]	;DEFINE SOME ARRAYS.
DARR1:	PUSHJ P,GETNAM	;SCAN NAME.
	XWD DF,SWVBT	;TYPE PARAMETER TO GETNAM.
	PUSH P,A	;STACK PTR. TO ENTRY.
	PUSHJ P,SCAN	;LOOK FOR COMMA.
	CAMN A,COMMAV	;IS IT ONE ?
	JRST DARR1	;YES. GET MORE NAMES.
	CAME A,LPARV	;NO. SHOULD BE  A (.
	ERROR(MISSING LEFT PAREN.)
	PUSHJ P,SCAN	;GET THE DIMENSION.
	TLNN A,NUMFLG	;MAKE SURE IT'S A NUMBER.
	ERROR(IMPROPER DIMENSION)
	MOVE B,(A)	;GET VALUE.
	TLNN A,FIXFLG	;IS IT FLOATING ?
	FIX B,233000
;***********↑↑↑↑↑↑↑
DARR3:	AOS JOBFF	;GET  FREE STORAGE PTR.
	POP P,T		;PTR. TO NAME IN TABLE...
	JUMPE T,DARR2	;UNLESS ITS THE MARK.
	JUMPG T,DARR4	;WAS IT PREVIOUSLY DEFINED ?
	HRRZ T1,(T)	;YES. GET ITS BASE ADDRESS.
	CAMG B,-1(T1)	;IS NEW DIMENSION > OLD ?
	JRST DARR3	;NO. LEAVE OLD DEFINITION ALONE.
DARR4:	AOS A,JOBFF	;INCREMENT FREE STG. PTR. AGAIN.
	HRRM A,(T)	;PUT IN SYM. TABLE.
	MOVEM B,-1(A)	;PUT DIMENSION IN -1TH ELEMENT.
	HRLI A,INSXR	;PUT GOOD INDEX FIELD IN A...
	MOVEM A,-2(A)	;PUT PTR. TO ARRAY WITH INDEX IN AR[-2]
	ADDM B,JOBFF	;INCREMENT IT.
	JRST DARR3	;TRY FOR ANOTHER.
DARR2:	PUSHJ P,SCAN	;GET THE ).
	CAME A,RPARV
	ERROR(MISSING RIGHT PAREN.)
	PUSHJ P,SCAN
	CAMN A,COMMAV	;A COMMA ?
	JRST DARR	;YES. START OVER AGAIN.
	HRRZ JOBSYM	;LET'S FIND OUT IF WE'VE LOST...
	CAMG JOBFF	;IS TOP STILL ABOVE BOTTOM ?
	ERROR(STORAGE IS FULL)
	HRRZ JOBFF
	HRLM JOBSA
	JRST STATL1

; HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.

CHOWN1:	PUSHJ P,INTER1	;INTERPRET STATEMENT.
SCHOWN:	PUSHJ P,SMSC1	;GET FIRST NON-SEMICOLON.
CHOWN:	CAMN A,PLAYV	;IS IT A 'PLAY' SECTION ?
	JRST PLAY1	;YES.
	CAMN A,ALTV	;IS IT AN ALT MODE ?
	JRST COMMND	;YES. A COMMAND FOLLOWS.
	CAME A, COMPV	;A 'COMPILE' SECTION ?
	JRST CHOWN1	;NO. JUST A STATEMENT.
	PUSHJ P,SCOMP	;INIT. THE COMPILER.
	PUSHJ P,SSTATL	;COMPILE A STATEMENT LIST.
	PUSHJ P,LOADER	;LOAD THE CODE.
	JRST SCHOWN	;DONE WITH THAT SECTION.

PLAY1:	PUSHJ P,GSBUF	;WE'RE GOING TO PLAY; GET SAMPLE BUFFER.
	AOS SBCNT
PLAY1A:	SETZM TIME#	;T←0.
	SETZM RQPTR#	;RUN QUEUE IS EMPTY.
	SETZM MAXSMP#	;INIT. THE MAXIMUM SAMPLE REMEMBERER.
PLAY2:	PUSHJ P,SMSC1	;SCAN A NON-SEMICOLON.
	CAME A,FINV	;A 'FINISH ' ?
	CAMN A,PLAYV 	;... OR A 'PLAY' ?
	JRST PTERM	;YES. END OF SECTION.
	TLNE A,INSBIT	;AN INSTRUMENT NAME ?
	JRST PINS	;YES. A NOTE STATEMENT.
	PUSH P,[EXP PLAY2]	;NO. INTERPRET THE STATEMENT.
INTER1:	CAME A,INSV
	CAMN A,FUNV
	ERROR (ILLEGAL 'PLAY' STATEMENT)
	PUSHJ P,SCOMPA	;IT MUST BE A RANDOM STATEMENT.
		;PREPARE TO INTERPRET IT BY INITIALIZING 
		;THE COMPILER.
	PUSHJ P,STAT	;COMPILE THE STATEMENT.

INTERP:	MOVE A,[JRST INTER2]	;PREPARE TO EXECUTE TEMPORARY
	MOVEI B,0	;CODE (I.E,RUN IN INTERPRET MODE).
	PUSHJ P,EMICDI	;EMIT RETURN INSTR. AT END OF CODE.
	PUSHJ P,ENDP1	;CLEAN UP COMPILER.
	PUSH P,JOBFF	;SAVE FREE STG. PTR.
	PUSHJ P,LOADER	;LOAD THE TEMPORARY CODE.
	MOVEM P,PSV1#	;SAVE IT.
	MOVEM FL,FLSV1#
	MOVE 17,P	;PTR. FOR (UGH! BLETCH!) FOOTRAN PGMS.
	JRST @(P)	;EXECUTE IT.
INTER2:	MOVE P,PSV1	;RESTORE PUSHDOWN POINTER.
	MOVE FL,FLSV1
	POP P,0		;RETRIEVE OLD STG. PTR.
	HRRZM JOBFF	;FLUSH THE TEMP. CODE.
	HRLM JOBSA	;(IT HAS TO GO HERE TOO.)
	POPJ P,		;LOOK, MA, I'M AN INTERPRETER !!


;THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
; INSTRUMENT, AND GETS IT TURNED ON AT THE RIGHT TIME.

PINS:	MOVE A,(A)	;GET STARTING ADDRESSES FOR INSTRUMENT.
	PUSH P,(A)	;SAVE THEM.
	MOVEI PBASE	;PREPARE TO FILL THE P ARRAY WITH
	MOVEM PPTR1#	;THE PARAMETERS TO THE INSTR.
	PUSHJ P,SCOMPA	;INIT. COMPLR. FOR POSSIBLE EXPRESSIONS.
	MOVE NCHNS	;GET NO. OF OUTPUT CHANNELS.
	TLNE -1		;IS IT FLOATING ?
	FIX 233000
;**********↑↑↑↑↑↑↑↑↑
PINS2:	MOVEM NCHNS
	PUSH P,NUMBUC	;SAVE CURRENT STATE OF NUMBER
	PUSH P,JOBFF	;BUCKET AND CORE TOP.
	JRST PINSL	;INIT. THE COMPILER.


PINSL1:	CAMN A,COMMAV	;OPTIONAL COMMA BETWEEN PARAMS...
PINSL:	PUSHJ P,SCAN
	AOS PPTR1	;INCREMENT P-ARRAY POINTER.
	CAMN A,COMMAV	;A COMMA HERE MEANS MISSING
	JRST PINSL	;PARAM., SO DON'T CHANGE.
	CAMN A,SEMICV	;SEMICOLON ?
	JRST PINSB	;YES, END OF PARAMETERS.
	PUSHJ P,EXPR	;PARAMETER MAY BE EXPRESSION.
	PUSHJ P,GPONDER	;GET OPERAND POINTER FOR THE EXPR...
	TLNE T,SIACBT	;IS VALUE OF EXPR AN AC SYMBOL ?
	JRST PINS1	;YES. IT HAS TO BE CALCULATED.
	MOVE C,(T)	;PICK UP ITS VALUE.
	MOVEM C,@PPTR1	; SO PUT ITS VALUE IN P-ARRAY NOW.
	JRST PINSL1
PINS1:	PUSH P,A	;EXPR. GENERATED SOME CODE, EVIDENTLY.
	MOVE A,T	;EMIT AN INSTRUCTION TO STORE THE
	MOVE B,PPTR1	;RESULTANT VALUE IN THE P-ARRAY.
	MOVE C,[MOVEM EMICDI]
	PUSHJ P,EMINST	;THE CODE WILL GET EXECUTED 
	PUSHJ P,INTERP	; RIGHT NOW.
	PUSHJ P,SCOMPA
	POP P,A		
	JRST PINSL1	;BACK FOR MORE PARAMS.

;; MORE OF PINS.

PINSB:	POP OSP,JOBSYM	;FLUSH COMPLR. OUTPUT BUFFERS.
	POP P,0		;RECOVER OLD CORE TOP.
	MOVEM JOBFF	;RESET THINGS TO FORGET
	HRLM JOBSA	;ABOUT THE NUMBERS WE DEFINED WHILE
	POP P,NUMBUC	;SCANNING NOTE PARAMETERS.
	MOVE A,SRATE	;GET NO. OF SAMPLES/SEC.
	FDVR A,TIMESC	;DIVIDE BY BEATS/SEC.
	MOVE B,PBASE+1	;GET STARTING TIME FOR NOTE.
	FMPR B,A	;CONVERT TO SAMPLES.
	FADR B,[0.5]
	FIX B,233000
;***********↑↑↑↑↑↑↑↑↑
	MOVEM B,RQ1	;PLACE AT BOTTOM OF RUN QUEUE.
	FMPR A,PBASE+2	;GET DURATION OF NOTE IN SAMPLES.
	FADR A,[0.5]
	FIX A,233000
;***********↑↑↑↑↑↑↑↑↑
	ADD A,B		;CALC. ENDING TIME OF NOTE.
	PUSH P,A	;SAVE SAME.
	PUSHJ P,PLAYIT	;PLAY UP TO STARTING TIME OF NOTE.
PLYON:	AOS A,RQPTR	;NOW TURN INSTRUMENT ON.
	POP P,RQ1(A)	;PUT ENDING TIME IN RUNQUEUE, COL. ONE.
	POP P,T		;GET STARTING ADDR. OF INSTRUMENT.
	HLRZM T,RQ2(A)	;PLACE IN RUN QUEUE, COL. TWO.
	PUSHJ P,(T)	;EXECUTE THE I-TIME CODE.
	JRST PLAY2	;BACK FOR MORE NOTE STATEMENTS.

PTERM:	PUSH P,A	;HERE AT A 'PLAY' OR 'FINISH'.
	MOVSI 200000
	MOVEM RQ1	;SET UP FAKE STARTING TIME.
	PUSHJ P,PLAYIT	;FLUSH THE RUN QUEUE.
	POP P,A		
	CAMN A,PLAYV	;WAS IT A 'PLAY' THAT WE SAW ?
	JRST PLAY1A	;YES. START NEW SECTION.
	PUSHJ P,OSBUF	;NO, A 'FINISH'. EMPTY THE
	JRST SCHOWN	;SAMPLE BUFFER AND START OVER.

;; THIS ROUTINE GENERATES SAMPLES BY CALLING THE 
;; INSTRUMENTS IN THE RUN QUEUE UNTIL IT IS TIME
;; TO TURN ON THE INSTRUMENT WHOSE STARTING TIME IS
;; IN THE ZEROTH LOCATION OF THE QUEUE, WHEN IT RETURNS.
;; INSTRUMENTS ARE TURNED OFF AS REQUIRED.

PLAYIT:	MOVE A,RQPTR	;SEARCH FOR EARLIEST TIME IN QUEUE.
PLYT2:	MOVEM A,PTMP#	;SAVE ITS LOCATION.
	SKIPA H,RQ1(A)	;PICK IT UP.
	CAMG H,RQ1(A)	;A NEW MINIMUM ?
	SOJGE A,.-1	;NO.
	JUMPGE A,PLYT2	;YES.
PLYT1:	CAMN H,[XWD 200000,0]	;MIN. FOUND. IS IT THE TERMINATION
	POPJ P,		; MARK ? IF YES, THEN RETURN.
	SUB H,TIME	;IT'S NOT . CALC. DISTANCE IN FUTURE.
	JUMPLE H,PLYT3	;IF NOT IN FUTURE, FORGET IT.
	ADDM H,TIME	;MOVE TIME TO NEW VALUE.
PLYT4:	SKIPE OSP,RQPTR	;CYCLE THRU RUNNING INSTRS., IF ANY.
	PUSHJ P,@RQ2(OSP)	;CALL AN INSTR.
	SOJG OSP,.-1	;CALL THEM ALL.
	MOVEI F,1	;START WITH CHANNEL 1.
PLYT5:	SOSG SBCNT	;COUNT SAMPLE BUFFER COUNTER.
	PUSHJ P,FSBUF	;FLUSH FULL BUFFER.
	MOVEI B,0	;PICK UP NEXT CHANNEL'S SAMPLE, AND
	EXCH B,OUTA-1(F)	; ZERO THE LOCATION.
	FAD B,[0.5]	;ROUND TO NEAREST INTEGER.
	FIX B,233000	;A. KOTOK SHOULD HAVE DONE THIS.
;************↑↑↑↑↑↑↑↑
	MOVM A,B	;GET MAGNITUDE...
	CAMLE A,MAXSMP	;IS THIS SAMPLE THE BIGGEST YET ?
	MOVEM A,MAXSMP	;YUP.
	IDPB B,SBPTR	;PLACE IT IN SAMPLE BUFFER.
;S	CAMGE F,NCHNS	;LAST CHANNEL ?
;S	AOJA F,PLYT5	;NO. GET OTHER CHANNELS.
	SOJG H,PLYT4	;GENERATE REST OF SAMPLES.

PLYT3:	SKIPG A,PTMP	;GET PTR. TO NEXT INSTR. OFF OR ON.
	POPJ P,		;TIME TO TURN ONE ON.
	SOS B,RQPTR	;REMOVE INSTR. FROM QUEUE.
	MOVE RQ1+1(B)	;MOVE TOP ENTRY DOWN INTO VACANT
	MOVEM RQ1(A)	;SPOT.
	MOVE RQ2+1(B)
	MOVEM RQ2(A)	
	JRST PLAYIT	;GO PLAY TILL NEXT EVENT.


;; RANDOM ROUTINES TO HANDLE THE SAMPLE OUTPUT BUFFER.

GSBUF:	HRRZ T,JOBSYM	;GET A SAMPLE BUFFER.
	SUB T,JOBFF	;HOW MUCH ROOM IS LEFT ?
	SUBI T,4*LOBUFS	;(ALLOWING ROOM FOR CODE BUFFERS)
;	SKIPN BIGBIT	;SETS LSBUF TO 1024 IF EITHER BIGBIT OR RCDFLG!
	SKIPN RCDFLG
;	SKIPA
	JRST GSBUF1	;1023 IS FOR DEFERRED LONGPLAY
	CAIGE T,=1024	;1024 IS FOR IMMEDIATE LONGPLAY WITH 'PLAY'
	ERROR (ADD 1K OF CORE!)
;	MOVEI T,=1023	
;	SKIPGE RCDFLG	;IS IT POSITIVE OR ZERO?
	MOVEI T,=1024	;NO,  RCDFLG←-1; IS FOR IMMEDIATE LONGPLAY
GSBUF1:	MOVEM T,LSBUF	;PUT AWAY.
	MOVNS T
	PUSHJ P,GFS	;GRAB ENOUGH FREE STORAGE...
	HRRZM T,SBBOTT#	;SAVE PTR. TO BUFFER.
FSBUF2:	HRLI T,441400	;MAKE BYTE POINTER.
;	SKIPE BIGBIT	;IS IT 18 BIT?	
;	HRLI T,442200	;YES. RESET BYTE SIZE	
	MOVEM T,SBPTR#	;
	MOVE T,LSBUF	;GET LENGTH OF BUFFER.
	ASH T,1		;SAMPLE CT = LSBUF *2 FOR 18 BIT
;	SKIPN BIGBIT	;IS IT 18 BIT?
	ADD T,LSBUF	;NO, MAKE * 3.
	MOVEM T,SBCNT#
	POPJ P,

OSBUF:	HRRZ LSBUF	;THROW OUT SAMPLE BUFFER...
	ADDM JOBSYM
	MOVEI 0
	SKIPA T,SBCNT
	IDPB 0,SBPTR
	SOJG T,.-1
	JRST FSBUF

SMPOUT:	MOVE SBBOTT
	MOVEM IBOTT
	JSA 16, SMPLS	;CALL WRITING ROUTINE
	JUMP LSBUF
	JUMP SBCNT
IBOTT:	0
	JUMP MAXSMP
	JUMP RCDFLG	; NOW A DUMMY
	JUMP RCDFLG	;RCDFLG←-1 WRITES ONE LONG .DMD FILE 6/71
;;	SKIPN BIGBIT
	SKIPN RCDFLG	;RCDFLG ON?
;	SKIPE DOPLAY	;PLAY ANYWAY?
	JRST FSBUF1	;GO TO PLAY
	JRST FSBF2A	;DOESN'T PLAY


;FSBUF:	SKIPN BIGBIT
FSBUF:	SKIPE RCDFLG#	;OUTPUT TO DISC?
	JRST SMPOUT
FSBUF1:	HRR SBBOTT	;CALCULATE NEGATIVE WORD COUNT.
	SUB SBPTR
	SUBI 1		;PREVENT 0 WORD COUNTS.
	HRRZ T,SBBOTT	;GET BOTTOM OF BUFFER....
	HRLI -1(T)	; MINUS ONE.
	MOVSM OUTWC	;PUT IOWD IN RIGHT PLACE.
;*** SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *******************
	PUSHJ P,FSBF1
	JRST FSBF2
FSBF1:	MOVE NCHNS	;NO. OF OUTPUT CHANNELS.
	TLNE -1
	FIX 233000
;**************↑↑↑↑↑↑↑
FSBF3:	SUBI 1		;THIS LABEL APPARENTLY NOT USED ELSEWHERE
;;;;;;FSBF1:	MOVEI 0,1	;1 CHAN. ONLY IN THIS VERSION!
	DPB [POINT 2,OUTBIT,26]	;STEREO OR MONO MODE.
	MOVM SPEED
	TLNE -1		;FIX IF NECESSARY.
	FIX 233000
;*********↑↑↑↑↑↑↑↑↑
FSBF4:	DPB [POINT 3,OUTBIT,32]
L1:	INIT ADCHN,17
	SIXBIT /AD/
	0
	ERROR (A-D UNAVAILABLE.)
	POPJ P,

XGP:	MOVSI	'XGP'	;TO AVOID XGP CONFILICT
	DEVUSE	0,
	HLRZ	0,0
	CAIN	400000
	POPJ P,
	INIT	16,17
	SIXBIT	.XGP.
	0
	JRST XGP	;was  JRA	16,2(16)
	POPJ P,
FSBF2:	PUSHJ P,XGP	;GO INIT THE XGP
	OUTPUT ADCHN,OUTWC	;EMPTY THE BUFFER.
	RELEAS ADCHN,
	RELEASE 16,
FSBF2A:	MOVE T,SBBOTT	;NOW SET UP POINTERS AGAIN.
	JRST FSBUF2

OUTWC:	0
	3650	;MAGIC BITS FOR 136.
OUTBIT:	4000	;BITS FOR A-D.
	BLOCK 2

;; ERROR HANDLING(?) ROUTINES.

ERR1:	0	;HERE FROM UUO TRAP.
	TLNE FL,ERRFLG	;IN ERROR SKIPPING MODE ?
	JRST 2,@ERR1	;YES.
	MOVEM 17,ERSVAC+17	;NO. SAVE ACS.
	MOVEI 17,ERSVAC
	BLT 17,ERSVAC+16
	JSR ERR2	;PRINT MESSAGE.
	MOVSI 17,ERSVAC	;RESTORE AC'S.
	BLT 17,17
ERRX:	TLO FL,ERRFLG	;ENTER ERROR-SKIPPING MODE.
	RELEAS TTY,0
	RELEAS DT,0
	PUSHJ P,SETUP1
	JRST GOB
	JRST 2,@ERR1	;TRY TO CONTINUE (HO, HO.).

ERSVAC:	BLOCK 20

ERR2:	0	;ERROR MESSAGE PRINTER.
	HRRZI [ASCIZ /
$$$ ERROR:   /]
	JSR TXTOUT
	HRRZ 40
	JSR TXTOUT
	HRRZI [ASCIZ /
/]
	JSR TXTOUT
	MOVE A,ISCP
	MOVE B,A
	MOVE C,B
ERR2B:	ILDB A
	CAIE 15
	JRST ERR2A
	MOVE C,B
	MOVE B,A
ERR2A:	CAME A,SCP
	JRST ERR2B
	JRST ERR2D
ERR2C:	SOSGE TOB+2
	OUTPUT TTY,0
	IDPB TOB+1
ERR2D:	ILDB C
	CAME C,SCP
	JRST ERR2C
	SKIPN SNCHR
	IDPB TOB+1
	OUTPUT TTY,0
	JRST @ERR2




SYMSCH:	MOVEI T,6	;LOOK UP EXTERNAL SYMBOL.
	MOVE [POINT 6,ACCUM,5]	;PREPARE TO CONVERT TO
	MOVEI B,0
SYMS1:	ILDB A,0	;RADIX 50.
	JUMPE A,SYMS4
	CAIN A,16
	MOVEI A,73
	CAIG A,5
	ADDI A,70
	CAIGE A,32
	ADDI A,7
	IMULI B,50
	ADDI B,-26(A)
	SOJG T,SYMS1
SYMS4:	TLO B,40000
	MOVE A,116
SYMS3:	AOBJP A,SYMS2
	CAME B,-1(A)
	AOBJN A,SYMS3
SYMS2:	SKIPL A
	SKIPA A,[EXP NX]
	HRRZ A,(A)
	POPJ P,

NX:	0
	ERROR (MISSING EXTERNAL FUNCTION)
	JRST INTER2


INTERNAL RDNUM,MESS,PNUM

EXTERNAL JOBDDT;
PNUM:	0
	MOVE P,JOBFF
	SKIPGE A,@(RA)
	OUTCHR ["-"]
	MOVMS A
	PUSHJ P,DECPNT
	OUTPUT TTY,0
	JRA RA,1(RA)

RDNUM:	0	;NUMBER READER FOR FOOTRAN ROUTINES.
	MOVE P,JOBFF	;GET TEMP. PDL
	EXCH FL,FLSV1
RDNUM1:	TLO FL,SNUMF1
	PUSHJ P,SCAN
	CAMN A,MINV	;A MINUS SIGN ?
	TLOA FL,MINFLG	;YES. SET FLAG AND LOOP BACK.
	TLNN A,NUMFLG	;IT IS A NUMBER, ISN'T IT ?
	JRST RDNUM1	;NO. IGNORE IT.
	TLZE FL,MINFLG	;YES. HAVE WE SEEN A MINUS LATELY ?
	MOVNS C		;YES.
	MOVEM C,@(RA)	;PUT VALUE INTO PARAMETER.
	EXCH FL,FLSV1
	JRA RA,1(RA)	;RETURN TO (UGH ! BLETCH !) FOOTRAN.
MESS:	0		;MESSAGE PRINTER FOR FOOTRAN ROUTINES.
	HRRZ (RA)	;GET LOC. OF MESSAGE.
	CALLI 3
	JRA RA,1(RA)

FOOPRT:	0
	MOVM A,@(RA)
	TLNE A,777000
	FIX A,233000
;**********↑↑↑↑↑↑↑↑↑↑↑
	PUSHJ P,DECPNT
	OUTPUT TTY,0
	JRST 1(RA)

COMMND:	MOVEI [ASCII /$/]
	CALLI 3
	PUSHJ P,SCANNS	;GET COMMAND.
	JUMPL A,COMND1
	MOVE ACCUM
	MOVE 1,ACCUM+1
	LSHC 6
	CAMN [SIXBIT /RESET/]
	JRST REST1
	CAMN [SIXBIT /PRINT/]
	JRST CPNT	;A 'PRINT' COMMAND.
	CAMN [SIXBIT /P/]
	JRST CPLX
	CAMN [SIXBIT /DDT/]
	JRST @JOBDDT
COMND1:	MOVEI [ASCIZ /?? /]
	CALLI 3
	JRST SCHOWN
CPLX:	PUSHJ P,CGNUM	;GET FOLLOWING NUMBER, IF ANY.
	MOVEI T,1	;NO NUMBER. TAKE AS 1.
CPLAY:	
;	SKIPE DSKFLG	;DISK OUTPUT ?
;	JRST DSKPLA	;YES.
;*********  SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *********
	PUSHJ P,FSBF1	;SET UP FOR D-A OUTPUT.
	PUSHJ P,XGP
	OUTPUT ADCHN,OUTWC
	SOJG T,CPLAY	;REPEAT AS INDICATED BY ARGUMENT.
	RELEAS ADCHN,
	RELEASE 16,
	JRST SCHOWN


REST1:	MOVEI TEMPSY
	MOVEM BUCTBL
	JRST GO

;MORE COMMAND ROUTINES.

CPNT:	PUSHJ P,SCOMPA	;INIT. THE COMPILER.
	PUSH OSP,[XWD VRBLBT,[XWD VRBLBT,CPNTX#]]	;PUT FAKE VARIABLE IN STACK.
	PUSHJ P,ASTMT1		;COMPILE RIGHT PART OF AN ASSIGNENT STATEMENT.
	PUSHJ P,INTERP		;EXECUTE THE CODE.
;*****  SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *****************
	MOVM A,CPNTX	;GET ITS VALUE.
	TLNE A,377000	;ASSUMING ITS >0, IS IT FLOATING?
	FIX A,233000
;***********↑↑↑↑↑↑↑↑↑
CPNT2:	PUSHJ P,DECPNT	;PRINT IT.
	OUTPUT TTY,0
	POP P,A		;GET THING WHICH TERMINATED EXPR. (LEFT ON STACK BY ASTMT1).
	CAMN A,SEMICV	;A SEMICOLON ?
	JRST SCHOWN	;YES. FORGET IT.
	JRST CHOWN	;NO. LOOK AT IT.


CGNUM:	TLO FL,SNUMF1	;DONT PUT NO.'S IN TABLE.
	PUSHJ P,SCAN	;LOOK FOR (OPTIONAL) NUMERIC ARGUMENT.
	TLNN A,NUMFLG	;IS THERE ONE ?
	POPJ P,		;NO.
	MOVE T,C	;YES. GET VALUE.
	TLNN A,FIXFLG	;IS IT FLOATING ?
	FIX T,233000	;NOT ANY MORE.
;*********↑↑↑↑↑↑↑↑↑↑↑
CGNUM2:	POP P,T1	;GET RETURN ADDR.
	JRST 1(T1)	;SKIP ON RETURN.
END GO